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An  addendum  to  GAMD-8073  by  W.  E.  Johnson.  This  section  is  broken 
down  into  5  parts  as  described  below. 

(A)  -TCLAM--the  generator  code  for  TOIL,  presents  sample  problem, 

and  instructions  for  usage. 

(B)  TOIL  Equations--d.iscusses  the  difference  equations  used  in  TOIL. 

(c)  Input  for  TOIL--describes  the  necessary  data  for  using  the 
TOIL  code. 


(D)  Definition  of  Variables — defines  the  variables  used  in  the 

TOIL  code .  I 

J 

(E)  TCLAM  and  TOIL--Fortran  listings,  consists  of  the  actual  Fortran 

■listings  with  an  abundant  sprinkling  of  comments.  -  ■ 


f 


1R  \S‘'  T!  'I  -l  m»  J 

A  *  u  V  h  ,  ,  , ,  . 

Aiv’n  A JLxOtc^  ,  si  ,»*  fi  !«  Otv  tlOHMtNT 
‘GROUND,  MARYLAND  2100&, 


rr  CACH 

M  »  MAY 

.  iJh  x.  v  u.  s. 

CtNTER,  ABERDEEN  PROVING 


1 


/ 


2 


A.  TCLAM  CODE 


General  Description 

TCLAM  is  a  numerical  code  that  provides  the  initial  configuration 
and  starting  conditions  for  the  TOIL  code.  This  involves  specifying  the 
dimensions  for  each  cell  and  the  density,  the  two  velocity  components  and 
the  specific  internal  energy. 

Below,  Fig.  1,  is  a  sketch  of  a  typical  two-dimensional  grid.  We 
display  only  a  plane  view,  keeping  in  mind  that  each  cell  is  really  a  solid 
of  revolution,  symmetric  about  the  2  axis.  In  the  discussion  to  follow, 
both  X  and  R  are  referred  to  as  the  radial  direction,  and  both  Y  and  Z 
refer  to  the  axial  direction. 


X  or  R 
Fig.  1 


i  is  the  right  boundary  and  j  is  the  top  boundary  of  cell  K. 
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i 

x(i)  =  y  ^xu) 

i=l 

J 

Y(j)  =  Y  AY(j) 

j=l 

The  area  of  cell  (i, j)  in  the  i  direction  =  2n  X(i)  AY(j). 

The  area  of  cell  in  the  j  direction  =  n(X^j  -  X^ 

K  is  defined  as  (j-l)  iMAX  +  i  +  1,  and  is  the  index  for  all  cell 
centered  quantities. 

First,  we  specify  the  total  number  of  cells  in  the  X  direction  (iMAX) 
and  the  total  number  of  cells  in  the  Y  direction  (jMAX).  In  addition,  we 
specify  the  AX  ani  AY  for  each  cell.  TCLAM  then  calculates  the  X(i)  and 
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Y(j)  of  each  cell  and  the  axial  area  (TAU(i)  =  n(x^\j  -  ^). 

Next,  specify  the  data  for  the  various  packages.  This  consists  first 
of  specifying  the  number  of  particles  per  cell  for  this  package,  and  the 
type  of  material,  and  the  origin  of  the  radius  vector  for  the  density,  energy 
and  velocity  functions.  We  also  specify  one  of  the  6  possible  fits  for  the 
density,  energy  and  velocity  functions. 

Next,  specify  the  type  of  geometry  (the  configuration),  of  which  there 
are  four  possible:  circle,  ellipse,  rectangle  and  triangle.  Thus,  the  con- 
fig  uration  can  be  broken  up  into  combinations  of  the  four  possible  geometries 
(note,  these  geometries  are  really  solids  of  revolution  for  the  cylindrical 
geometry).  The  data  for  these  geometries  are  stored  in  the  array  (TAB).  A 
counter  (IWS)  is  calculated  from  the  initial  data.  This  counter  is  stored 
in  the  first  word  of  the  TAB  block  for  each  package.  Its  values  are  as 
follows : 


H- 

c n 

u 

V-* 

delete  this  triangle 

iWS  =  2 

generate  this  triangle 

iWS  =  3 

delete  this  rectangle 

iWS  -  h 

generate  this  rectangle 

iWS  =  5 

delete  this  circle  or  ellipse 

iWS  =  6 

g...erate  this  circle  or  ellipse 

The  next  6  words  of  this  TAB  block  contain  the  coordinates  of  the 
desired  geometry.  The  next  card  contains  the  data  for  the  density  fit  and 
we  store  this  data  in  the  array  (TABR).  Next,  read  in  the  data  for  the 
internal  energy  and  store  it  in  the  TABI  array.  The  last  data  card  of  each 
package  contains  the  input  for  the  velocity  fit,  and  this  data  is  stored  in 
the  TABUV  array. 


We  then  compute  the  boundaries  of  the  specified  geometry,  and  the 
minimum  and  maximum  i  and  j  values  for  this  geometry. 

Next  we  subdivide  all  the  cells  in  this  package  into  N  (the  number  of 
particles  per  cell)  equal  area  cells.  The  particles  are  placed  at  the  center 
of  each  sub-cell,  where  the  volume  of  the  sub-cell  =  2«(XL)(DY/WS)(DX/WS) 
where  WS  =  (N)s  and  XL  =  the  X  value  of  the  center  of  the  sub- cell.  Some 
of  the  particles  (n)  may  not  be  generated,  however,  for  if  the  boundary  of 
the  geometry  passes  through  the  cell,  those  particles  that  fall  outside  of 
the  boundary  are  deleted. 


We  assign  a  density,  two  velocity  components  and  a  specific  internal 
energy  to  each  package.  These  may  be  any  function  of  XL,  YL  or  R  where 
XL  =  X  coordinate  of  the  particle  N,  YL  =  Y  coordinate  of  particle  N,  and 
R  =  (TTX2  +  TTY2)2  where  TTX  =  XL  -  XC  and  TTY  =  YL  -  YC;  XC  and  YC  are 
the  coordinates  of  the  origin  of  the  radius  vector  R,  they  are  inputed  on 
the  first  card  of  each  package.  The  mass  of  each  particle  is  the  density 
times  the  volume  of  the  subdivision  cell  of  cell  K. 


After  processing  all  N  particles  for  cell  K,  we  calculate  the  total 
mass  of  cell  K  as 


N 


n=l 


N  N 

the  axial  momenta  as  Y  V  m  ,  the  radial  momenta  as  Y  U  m  and  the 

•  m  i  n  n  “Tn  n  n 

N  n=l  n=l 

internal  energy  as  Y  I  m  .  In  addition,  the  total  energy  and  mass  of  all 

n=l  ^  ^ 

cells  are  summed  up  for  the  entire  package. 


The  normal  units  for  TCLAM  are  as  follows: 

m  ~  particle  mass  in  grams 

AMX  =  mass  of  cell  K  in  grams  for  the  (x)  material 

AMD  =  mass  of  cell  K  in  grams  for  the  (.)  material 

-ft 

U  =  radial  velocity  in  cm/shake  (l  shake  =  10  sec) 

V  =  axial  velocity  in  cm/shake 

AiX  =  specific  internal  energy  in  jerks/gram  for  (x)  material  (1  jerk 

inl6  \ 

=  10  ergs) 

AiD  =  specific  internal  energy  in  jerks/gram  for  (.)  material. 

After  all  cells  in  this  package  have  been  processed,  we  read  in 
another  package  and  proceed  as  before. 

After  all  packages  have  been  processed,  we  then  convert  the  axial  and 
radial  momenta  of  each  cell  K  to  an  axial  and  radial  velocity  component.  The 
internal  energy  of  cell  K  is  converted  to  specific  internal  energy. 

The  output  from  TCLAM  (a  binary  tape,  that  can  be  read  by  the  TOIL  code) 
consists  of  the  cell  dimensions,  total  number  of  cells  in  both  directions,  the 
mass  and  two  velocity  components,  the  specific  internal  energy  of  each  cell  K 
and  other  information  required  for  the  TOIL  program. 

The  Fortran  symbols  and  units  are  listed  below: 

AMD  =  total  mass  in  cell  K  (grams)  for  the  (.)  material 
AMX  =  total  mass  in  cell  K  (grams)  for  the  (x)  material 
AiX  =  specific  internal  eno"gy  in  cell  K  (jerks/gram)  for  (x)  matex’ial 

AiD  =  specific  internal  energy  in  cell  K  (jerks/gram)  for  (.)  material 

U  =  radial  velocity  of  cell  K  (cm/shake) 

V  =  axial  velocity  of  cell  K  (cm/shake) 

X  =  dimension  in  cm  of  the  right  boundary  of  the  cell 

V  =  dimension  in  cm  of  the  top  boundary  of  the  cell 

.iMAX  a  total  number  of  cells  in  the  X  direction 

jMAX  =  total  number  of  cells  in  i he  Y  direction 

kMAX  "  ( iMAX )( JMAX )  +  1. 
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For  clarification,  in  generating  data  for  the  TOIL  code,  the  creation 
of  particles  is  only  a  computational  technique  to  give  the  proper  density, 
velocity  and  internal  energy  as  specified.  These  particles  are  not  saved 
after  they  have  been  summed  for  the  cell  in  question. 

Below  we  list  a  complete  description  of  the  required  input  and  format 
for  the  TCLAM  code. 

INPUT  DESCRIPTION  FOR  TCLAM 

An  asterisk  before  the  work  signifies  that  the  data  is  floating  point; 
otherwise  it  is  fixed  point  data. 

Card  No.  Column  No.  Description 

1  2-72  Header  card,  any  BCD  information. 

2  *  1-10  Contain  the  problem  number. 

*  11-20  iMAX,  the  number  of  cells  in  the  X-direction 

(maximum  of  100). 

*  21-30  jMAX,  the  number  of  cells  in  the  Y-direction 

(maximum  of  100 ). 

*  31  -  40  =  0. 

*  4l  -  50  2. 

*  51-60  Blank. 

*  61  -  70  Blank. 

71  -  72  N7  =  binary  tape  number. 

3  (2  number  3  cards  is  the  minimum) 

1  A  (l)  indicates  that  this  is  the  last  DX  or 

DY  card  to  be  read  in. 

A  (0)  indicates  that  there  will  be  more  DX 
•  or  DY  cards. 


2 


A  (0)  indicates  DX  data. 
A  (l)  indicates  DY  data. 


Card  No. 


Column  No. 


Description 


3  -  4 


* 

* 


* 


7  -  8 

9-10 

11  -  20 
21  -  30 
31  -  40 
41  -  50 
1-10 
11  -  20 
21  -  30 
31  -  40 


Indicates  the  number  of  zones  that  will 
have  the  same  DX  or  DY  values  that  appear 
in  Columns  11  -  20. 

Indicates  the  number  of  zones  that  will 
have  the  same  DX  or  DY  values  that  appear 
in  Columns  21  -  30. 

Indicates  the  number  of  zones  that  will 
have  the  same  DX  or  DY  values  that  appear 
in  Columns  31  -  40. 

Indicates  the  number  of  zones  that  will 
have  the  same  DX  or  DY  values  that  appear 
in  Columns  4l  -  50. 

The  value  of  DX  or  DY. 

The  value  of  DX  or  DY. 

The  value  of  DX  or  DY. 

The  value  of  DX  or  DY. 

Blank. 

Blank. 

80. 

Blank. 


Now  we  begin  leading  the  data  to  generate  a  package.  The  maximum 
number  of  gometries  that  may  be  generated  is  72;  to  increase  the  maximum  re¬ 
quires  the  changing  of  dimensions. 


1 

2 


5  -  7 


Load  a  1  here. 

A  (l)  implies  that  X  material  will  be  gene¬ 
rated  in  this  package. 

A  (0)  implies  that  dot  material  will  be 
generated. 

(N  ),  the  number  of  particles  per  cell  to 
be  generated,  where  is  1)5  20.  Note,  the 
unit  digit  in  Column  7  the  10  digit  in 
Column  6,  the  100  digit  in  Column  5* 
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Card  No.  Column  No. 


*  11-20 


*  21  -  30 


*  31  -  40 


*  4l  -  70 


Description 

YC  =  Y  coordinate  for  the  origin  of  the 
radius  vector  used  ■•in  the  density,  energy 
and  velocity  fits. 

XC  =  X  coordinate  for  the  origin  of  the 
radius  vector  used  in  the  density,  energy 
and  velocity  fits. 

A  number  (l  through  6)  that  specifies  the 
fit  number  or  subroutine  to  use  for  this 
package  to  calculate  the  density,  velocities 
and  specific  internal  energy  of  the  N 
particles. 

Blank. 


Following  the  first  card  of  each  package  are  five  other  types  of  cards. 

1.  Generate  geometry  (see  options  below). 

2.  Delete  geometry  (see  options  below). 

3*  A  density  card  (only  one  per  package). 

4.  An  energy  card  (only  one  per  package). 

5.  A  velocity  card  (only  one  per  package). 

For  cards  (l)  and  (2),  TCLAM  has  the  following  geometric  options  for 
generating  or  deleting: 


1.  A  rectangle  A  (4)  in  Column  1. 

Columns  2-6  are  blank. 

A  (1)  in  Column  7  means  to  generate  this 
rectangle. 

A  (0)  in  Column  7  means  to  delete  this  • 
rectangle. 


* 

11  - 

20 

XI  =  the 

-* 

21  - 

30 

X2  =  the 

* 

31  - 

40 

Y1  =  the 

* 

41  - 

50 

Y2  =  the 

left  X  coordinate  of  this 
right  X  coordinate  of  this 
lower  Y  coordinate  of  this 
upper  Y  coordinate  of  this 


rectangle. 

x’ectangle. 

rectangle. 

rectangle. 
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Card.  No. 


Column  No. 


Description 


2.  A  triangle 


*  11-20 
*  21-30 

*  31  -  40 

*  4l  -  50 

*  51  -  60 

*  61  -  70 

3.  An  ellipse  or  circle 


A  (6)  in  Column  1,  Columns  2-6  are  blank. 

A  (l)  in  Column  7  means  to  generate'  this 
triangle. 

A  (o)  in  Column  7  means  to  delete  this 
triangle. 


NOTE:  Vertices  (1-3)  can  be 
in  any  order. 


A  (4l)  in  Columns  (1-2),  Columns  3  “  6 
are  blank. 

A  (l)  in  Column  7  means  to  generate  this 
ellipse  or  circle. 

A  (0)  in  Column  7  means  to  delete  this 
ellipse  or  circle. 


11  -  20 


21  -  30 


31  -  40 


4l  -  50 


The  semi-axis  in  the  X-direction  if  an 
ellipse  or  the  radius  if  for  a  circle. 

The  semi-axis  in  the  Y-direction  if  an 
ellipse  or  zero  for  a  circle. 

The  X-coordinate  of  the  center  of  ellipse 
or  circle. 

The  Y- coordinate  of  the  center  of  ellipse 
or  circle. 


Following  the  geometry  cards  are  the  following  data  cards  that  refer 
to  all  cells  within  this  package: 

Density  cai’d  -  a  51  in  Columns  (l-2). 

Energy  card  -  a  52  in  Columns  (l-2). 

Velocity  card  -  a  53  in  Columns  (l-2). 

NOTE:  If  in  this  package,  the  density  or  internal  energy  or  velo¬ 
cities  will  remain  the  same  as  t  _•  previous  package,  then  a 
51,  52,  or  53  card  is  not  requii 
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Card  No. 

Column  No. 

Description 

* 

11  - 

20 

* 

21  - 

30 

* 

31  - 

40 

Contains  the  values  to  be  used  in  the 

* 

kl  - 

50. 

)  analytical  expressions  for  the  density, 
energy,  and  velocities. 

•* 

•51  - 

60 

* 

6l  - 

70  j 

This  data  is  loaded  into  the  following  Fortran  arrays; 

TABR  (1-6)  The  6  constants  available  for  the  density  fits.  • 

TABI  (1-6)  The  6  constants  available  for  the  internal  energy  fits. 

TABUV  (1-6)  The  6  constants  available  for  the  two  velocity 

components . 

Finally,  the  last  card  will  have  a  2  in  Column  1,  this  signifies  the 
completion  of  loading  all  input  cards  into  the  TCLAM  code. 


SPECIAL  SUBROUTINES 

There  are  six  subroutines  labeled  FIT  1  -  FIT  6,  used  to  compute  the 
density,  internal  energy  and  velocities. 

The  standard  input  to  these  subroutines  is  as  follows: 

TY  =  Y  coordinate  of  particle  N. 

TX  -  X  coordinate  of  particle  N. 


The  modified  coordinates  TTY  and  TTX  are  computed  as  follows : 

TTY  =  Y  coordinate  =  TY  -  YC  (relative  to  YC) 

TTX  =  X  coordinate  =  TX  -  XC  (relative  to  XC) 


Note:  YC  and  XC  are  the  Y  and  X  coordinate  for  the  origin  of 
the  radius  vector  used  in  the  density,  energy  and  velocity  fits. 

The  standard  output  from  these  subroutines  is  as  follows: 


WSR  -  contains 
WST  -  contains 
WSU  -  contains 
WSV  -  contains 


the  density  of  particle  N. 
the  specific  internal  energy  of  particle  N. 
the  radial  velocity  component  for  particle  N. 
the  axial  velocity  component  for  particle  N. 


1.  FIT  1 


R  =  (X2  +  Y2)^ 

2  2  \ 
WS  =  (TTX  +  TTY  )'2 


p  =  A  +  B  (Y  -  C) 

WSR  o  TABR(l)  +  TABR(2)  [TTY  -  TABR(3)] 
I  b  A  +  B  (Y  -  C) 

WSI  o  TABi(l)  +  TABi ( 2 )  [TTY  -  TABi(3)] 
U  =  0. 

\ 

WSU  o  o. 


V  =  A  +  B  (Y  -  c) 

WSV  =  TABUV(l)  +  TABUV(2)  [TTY  -TABUV(3)] 


2.  FIT  2 


.  o  o  \ 

R  =  (X  +  Y  )g 

WS  =  (TTX2  +  TTY2)* J 


P  = 


X^A 

B 


Y-C 

D 
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WSR  = 


\2 

TTX  -  TABR(l)  . 

[TTY  -  TABR(3) 

TABR(2 j  I 

[  tabr(4) 

2  2 

I  «s  A  +  BX  +  CX  +  DY  +  EY 

r 

WSI  n  TABi ( 1 )  +  TABi(2)(TTX)  +  TABi(3)(TTX)" 

2 

+  TABi(4)(lTY)  +  TABi(5)(TTY) 


U  =  C  +  DY 
WSU  »  TABUV ( 3 )  +  TABUV(A)  *  TTYj 

V  ^  A  +  BY 

V/SV  "  TABUV(l)  +  TABUV(2)  *  TTY_ 
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iMAX  =  20 
jMAX  =  29 


60  cm  from  the  ground 
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We  will  assume  the  source  to  he  of  the  same  material  as  the  ground, 
and  that  the  air  he  the  other  material. 

The  distribution  of  the  hot  source  might  be  as  follows: 


6  AX's  of  10  cm 
14  AX's  of  20  cm 

10  AY's  of  20  cin 
12  AY's  of  10  cm 

7  AY's  of  20  cm 

Package  (l)  generates  a  rectangle  (the  ground)  from  X.^  =  0  to  X2  =  340  cm 
and  from  Y^  =  0  to  Y^  =  200  cm 

1  particle/cell  and  YC  =  0  =  XC  (X  material) 

P  =  1-97 

1  =  0  Use  FIT  1 

U  =  V  =  0 

. 

Package  (2)  generates  a  circle  of  radius  5$  cm  at  X  =  0  and  Y  ~  260  cm. 
Generate  16  particles/cell  and  YC  =  260  cm  and  XC  =  0  (X  material).  The 
analytical  expressions  for  the  p,  V  and  I  are  as  follows: 

2 

p  -  A  +  BR  +  CR 
I  =  G  +  HR  +  KR2 
V  =  E  +  FR 

To  achieve  the  radial  distribution  for  the  2  velocity  components,  we 
will  program  a  new  FIT  subroutine,  say  FIT  4: 


WSR  =  TABR(l)  +  TABR(2)  WS  +  TABR(3)  WS2  =  A  +  BR  +  CR2  =  p  (density) 

WSi  -  TABi(l)  +  TABi(2)  WS  +  TABi ( 3 )  WS2  =  G  +  HR  +  KR2  =  I  (energy) 

WSA  =  TABUV(l)  =  TABUV ( 2 )  WS  =  E  +  FR 

mmy  y 

WSU  =  [WSA]  s  -  [E  +  FR]  =  U  (radial  velocity  component) 

TTY  -  Y 

WSV  =  [WSA]  ==  —  (E  +  FR]  =  V  (axial  velocity  component) 

Package  (3)  generates  a  rectangle  from  XI  =  0  to  X2  =  340  cm  and 
for  Y1  =  200  to  Y2  =  440  cm. 

16  particles/cell  and  YC  =  XC  =  0  (dot  material) 
p  =  1  x  10"3 

1=0  Use  FIT  1 

U  =  V  =  0 

The  values  of  the  TABi,  TABR  and  TABUV  arrays  are  read  in  on  the  $1, 
52,  and  53  cards. 

A  card  with  a  2  in  Column  1  completes  the  data  for  the  TCLAM  code. 

A  subroutine  SETUP  is  available  to  generate  the  initial  grid  (by¬ 
passes  this  generator  code .TCLAM)  if  both  the  target  and  projectile  are  of 
the  same  density.  In  addition,  the  projectile  must  be  a  right  cylinder, 
with  all  the  AX's  as  constant,  and  all  AY's  constant. 

OUrPUT  FROM  TCIAM 

The  output,  to  be  written  on  a  binary  tape,  from  the  TCLAM  code  is 
the  entire  Z  block  (defined  below),  all  the  cell  quantities  (the  two  velocity 
components,  the  mass  and  internal  energy),  and  the  cell  dimensions  and  areas. 
In  the  case  where  it  is  a  particle  run,  the  particles  (their  two  coordinates 
and  mass)  and  the  i  and  j  of  the  cell  where  the  particle  is  located) 
are  also  put  onto  the  binary  tape. 


The  normal  system  of  units  are  the  cm-g-shake,  where  the  units  of 

energy  are  jei’ks/g  and  the  pressure  in  units  of  jerks/cnr  (l  jerk  =  10  ergs 
-8 

and  1  shake  =  10  sec). 

The  Z  block  or  array  contains  the  number  of  cells,  the  number  of 
zones  in  both  directions,  and  other  necessary  information  to  start  the  TOIL 
code.  Below  is  a  complete  list  of  the  Z  block  generated,  which  is  then 
written  on  the  binary  output  tape. 


z 

Eauiv. 

Units 

Description 

1 

PROB 

- 

Equals  problem  number,  input  to  TCLAM. 

2 

CYCLE 

- 

Equals  cycle  number  =  0. 

3 

DT 

shake 

Set  to  C  by  TCLAM. 

4 

PRINTS 

- 

Set  to  0  by  TCLAM. 

5 

PRINTL 

- 

Set  to  0  by  TCLAM. 

6 

DUMPT7 

- 

Set  to  0  by  TCLAM. 

7 

CSTOP 

- 

Set  to  0  by  TCLAM* 

8 

PIDY 

- 

Equals  «  =  3*1415927. 

9 

TMZ 

grams 

Total  mass  (X  +  . )  generated  by  TCLAM. 

10 

GAM 

- 

If  =  0.  a  cylindrical  problem. 

ll 

GAMD 

- 

Set  to  0  by  TCLAM. 

12 

GAMX 

- 

Set  to  0  by  TCLAM* 

13 

ETH 

jerk 

Total  energy  in  system. 

14 

FFA 

- 

Set  to  0  by  TCLAM* 

15 

FFB 

- 

Set  to  0  by  TCLAM* , 

16 

TMDZ 

grams 

Total  mass  (.)  generated  by  TCLAM. 

17 

TMXZ 

grams 

Total  mass  (x)  generated  by  TCLAM. 

18 

XMAX 

cm 

=  X(iMAX). 

19 

TXMAX 

cm 

=  2. XMAX. 

20 

TYMAX 

cm 

=  2.YMAX  (NOTE:  YMAX  is  not  in  Z  block). 

21 

AMDM 

grams 

=  minimum  mass/2,  of  the  dot  particles. 

22 

AMXM 

grams 

=  minimum  mass/2,  of  the  X  particles. 

23 

DNN 

- 

Set  to  0  by  TCLAM. 

24 

DMIN 

- 

Set  to  0  by  TCLAM. 

25 

FEF 

- 

Set  to  0  by  TCLAM. 

26 

DTNA 

- 

Set  to  0  by  TCLAM. 
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z 

Eauiv. 

Units 

Description 

27 

CVIS 

- 

Set  to  0  by  TCLAM. 

28 

NPR 

- 

Set  equal  to  6  in  TCLAM. 

29 

NPRi 

- 

TCLAM  sets  NPRi  =  N4  (check  definition  of 
N4(z(54)). 

30 

NC 

- 

Fixed  value  of  cycle  number,  set  to  0  by  TCLAM 

31 

NPC 

- 

Used  as  indices  in  TCLAM. 

32 

NRC 

- 

Used  as  indices  in  TCLAM. 

33 

iMAX 

- 

Input  to  TCLAM  =  maximum  number  of  zones  in 

X  direction  for  this  run. 

34 

iMAXA 

- 

Equal  iMAX  +  1. 

35 

jMAX 

- 

Input  to  TCLAM  =  maximum  number  of  zones  in 

Y  direction  for  this  run. 

36 

JMAXA 

- 

=  jMAX  +  1. 

37 

KMAX 

- 

=  ( iMAX ) ( jMAX )  +  1. 

38 

KMAXA 

- 

=  KMAX  +  1. 

39 

NMAX 

- 

-  total  number  of  particles  +  1  that  TCLAM 
has  generated. 

40 

ND 

- 

=  total  number  of  dot  particles  +  1  that  TCLAM 
has  generated. 

4l 

KDT 

- 

Set  to  0  by  TCLAM. 

42 

iXMAX 

- 

=  iMAXA  +  1. 

43 

NOD 

- 

Used  as  index. 

44 

NOPR 

- 

Set  equal  to  N3  (Note  definition  of  N3(z(53))* 

45 

NiMAX 

- 

Set  to  0  by  TCLAM. 

46 

NjMAX 

- 

Set  to  0  by  TCLAM. 

47 

il 

- 

Set  to  0  by  TCLAM. 

48 

12 

- 

Set  to  0  by  TCLAM. 

49 

13 

- 

Set  to  0  by  TCLAM. 

50 

14 

- 

Set  to  0  by  TCLAM. 

51 

N1 

- 

=  scratch  tape  number. 

52 

N2 

- 

=  scratch  tape  number. 

53 

N3 

- 

=  number  of  particle  records  of  length  N4  -  1 
that  TCLAM  has  generated. 

54 

n4 

- 

=  number  of  particle  records  +  l  to  be  stored 
on  each  particle  tape  record. 

55 

N5 

- 

Set  to  0  by  TCLAM. 
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z 

Equiv. 

Units 

Description 

56 

n6 

- 

=  number  of  particles  on  the  last  particle 
tape  record. 

57 

N7 

- 

=  binary  tape  designation  number. 

58 

N8 

- 

Set  to  0  by  TCLAM. 

59 

N9 

- 

Set  to  0  by  TCLAM. 

60 

N10 

- 

Set  to  0  by  TCLAM. 

61 

Nil 

- 

Set  to  0  by  TCLAM. 

62 

NRM 

~ 

Set  to  0  by  TCLAM. 

63 

TRAD 

- 

Set  to  0  by  TCLAM. 

64 

XNRG 

- 

Set  to  0  by  TCLAM. 

65 

SN 

- 

Set  to  0  by  TCLAM. 

66 

DXN 

- 

Set  to  0  by  TCLAM. 

67 

RADER 

- 

Set  to  0  by  TCLAM. 

68 

RADET 

- 

Set  to  0  by  TCLAM. 

69 

RADEB 

- 

Set  to  0  by  TCLAM. 

70 

DTRAD 

- 

Set  to  0  by  TCLAM. 

71 

REZFCT 

- 

Set  to  0  by  TCLAM. 

72 

RSTOP 

- 

Set  to  0  by  TCLAM. 

73 

SHELL 

- 

A  counter  that  may  be  used  to  distinguish 
between  codes. 

74 

BBOUND 

- 

Set  to  0  by  TCLAM. 

75 

TOZONE 

- 

Set  to  0  by  TCIAM. 

76 

EDK 

- 

Set  to  0  by  TCLAM. 

77 

SBOUND 

- 

Set  to  0  by  TCLAM. 

78 

XI 

- 

Set  to  0  by  TCLAM. 

79 

X2 

- 

Set  to  0  by  TCLAM. 

80 

Y1 

- 

Set  to  0  by  TCLAM. 

81 

Y2 

- 

Set  to  0  by  TCLAM. 

82 

CABLN 

- 

Set  to  0  by  TCLAM. 

83 

vise 

- 

Set  to  0  by  TCLAM. 

84 

T 

- 

Set  to  0  by  TCLAM. 

85 

GMAX 

- 

Set  to  0  by  TCLAM. 

86 

WSGD 

- 

Set  to  0  by  TCLAM. 

87 

V/SGX 

- 

Set  to  0  by  TCLAM. 
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z 

Equiv. 

Units 

Description 

88 

GMADR 

- 

Set  to  0  by  TCLAM. 

89 

GMAXR 

- 

Set  to  0  by  TCLAM. 

90 

SI 

- 

Set  to  0  by  TCLAM. 

91 

S2 

- 

Set  to  0  by  TCLAM. 

92 

S3 

- 

Set  to  0  by  TCLAM. 

93 

S4 

- 

Set  to  0  by  TCIAM. 

94 

S5 

- 

Set  to  0  by  TCLAM. 

95 

s6 

- 

Set  to  0  by  TCLAM. 

96 

SY 

- 

Set  to  0  by  TCLAM. 

97 

s8 

- 

Used  for  storage  of  FIT  number  for  each  package 
in  TCLAM. 

98 

S9 

- 

Set  to  0  in  TCLAM. 

99 

S10 

- 

Set  to  0  in  TCLAM. 

Z(lOO)  through  Z(l50)  is  set  to  0  by  TCLAM. 


The  printed  output  from  TCLAM  is  as  follows: 

1.  The  problem  number,  iMAX  and  jMAX. 

2.  A  table  of  the  values  of  X(i)  from  i  =  1  to  iMAX. 

3-  A  table  of  the  values  of  Y(j)  from  j  >*  1  to  jMAX. 

4.  A  table  of  the  values  of  DX(i)  from  i  =  1  to  iMAX. 

A  table  of  the  values  of  DY(j)  from  j  =  1  to  jMAX. 

6.  A  table  of  the  area's  (in  the  axial  direction)  from  i  =  1  to 
iMAX. 

7.  Following  this  preliminary  printout  of  the  grid  quantities  we 
have  the  following  information  printed  out  per  package: 

(a)  The  package  number  and  the  number  of  particles  per  cell. 

(b)  The  6  constants  for  the  density,  energy  and  velocity  fits. 

(c)  The  type  of  geometry,  generate  or  delete,  followed  by  the 
coordinates  of  the  geometry. 

(d)  The  minimum  and  maximum  i  and  j  values  of  the  package 
in  question. 

(e)  The  total  number  of  particles,  the  type,  and  the  total 
energy  and  mass  in  this  package. 
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8.  After  all  package  information  is  edited,  a  statement  will  appear 
as  follows:  "There  are  no  more  packages."  The  total  energy  of 
the  system  is  edited,  followed  by  the  total  mass  and  particles. 

A  statement  "Tape  dump  at  time  0"  appears  next.  This  indicates 
that  the  binary  tape  was  written  successfully. 

9*  An  edit  of  each  column  of  the  occupied  grid  appears  next.  This 
contains  the  X,  DX  for  the  column,  and  the  Y,  DY,  U,  V,  AiD, 

AiX,  AMD  and  AMX  as  a  function  of  j.  This  completes  the  printed 
output  from  the  TCLAM  code. 
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B.  TOIL 


BASIC  EQUATIONS 

The  Eulerlan  equations  we  wish  to  solve  are  the  following: 

(A)  +  V  •  (pu)  =  0. 

—  ♦ 

(B)  ^  +  V  •  (puu)  =  -  V  P 

(C)  +  7  .  (pEu)  =  -  V  •  (Pu) 

Equation  (A)  is  :he  conservation  of  mass  equation  (B)  is  the  conservation  of 
momentum,  and  (c)  is  the  conservation  of  energy  equation. 

The  second  terms  on  the  left  side  of  Eqs.  (B)  and  (c)  are  temporarily 
dropped.  Their  contributions  are  later  approximated  when  we  move  mass  across 
cell  boundaries. 


Rewriting  Eqs.  (A),  (B),  and  (C)  in  cylindrical  coordinates  with  axis 

(1) 

(2) 

(3) 

00 

(5) 

p  =  density  of  cell  (K)  in  g/cm3, 
r  =  r  coordinate  in  cm, 
z  =  z  coordinate  in  cm, 


Eq: 

3 .  I 

(1),  (2), 

(3),  and  (k). 

Bp 

Srpu 

Spv 

St 

rSr 

Sz 

Su 

SP 

P 

St 

=  "  Sr 

'  Sv 

SP 

P 

St 

Sz 

SE 

SrPu 

SPv 

P 

St 

rSr 

Sz 

P 

=  r(P,x) 

Equation  of  State 

u  =  radial  component  of  velocity  in  cm/shake, 
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v  =  axial  component  of  velocity  in  cm/shake, 

P  =  material  pressure  in  jerks/cm  , 

E  =  total  specific  energy  in  jerks/g, 

16 

I  =  specific  internal  energy  in  jerks/g  (1  jerk  =  10  ergs),  and 

O 

t  =  time  in  shakes  (1  shake  =  10  sec). 

The  five  variables  listed  are  all  located  at  the  center  of  the  cell. 


Rewriting  Eq.  (4): 


or 


p  [I  +  |  (u2  +  v2)] 


drPu  SPv 
rdr  ~  3z 


P 


ai 

at 


+  pu 


du 

at 


+  pv 


av 

at 


p  aur  rap  ap  „  av 

r  ar  rar  sz  sz 


but 


thus 


ap 

ar 


and 


av  _  ap 
p  at  az 


1  aur\ 
r  dr/ 


This  is  then,  the  internal  energy  equation  that  we  will  integrate  in 
the  first  phase  of  our  calculations.  As  mentioned  previously,  the  solution 
to  the  three  equations  is  completed  in  two  steps.  The  first  step  (called 
PHI  in  TOIL),  the  momentum  and  energy  equation  as  a  function  of  the  pressure 
forces  only,  are  solved.  Then  in  the  second  step  (called  PH2)  we  appx*oximate 
those  transport  terms  (convective  terms)  that  we  omitted  in  the  first  phase 
by  transporting  mass,  momenta  and  energy  across  the  cell  boundaries. 


In  the  discussion  to  follow,  we  approximate  the  partial  differential 
equations  by  difference  equations. 


The  radial  momentum  equation  (2)  becomes  in  difference  form 


.i-i/g  '  h+i/s,  j-i/2 

2  Arj, 
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and  the  axial  momentum  equation  (3)  becomes 


Sv  Pj-3/2,  i-1/2  ~  Pj+l/2,  i-1/2 


at 


2*zj 


where  the  acceleration  of  a  cell  is  only  a  function  of  its  two  neighbor  cells 
(not  of  itself). 


Defining 


pn  +  pn 
n  _  Pi-3/2  Pi-l/2 

2. 


pn  4.  pn 

?RRn . 


pn  +  pn 

PBLO  =  - Li/i 

^  • 


p1^  +  p*1 

PABOVE  =  ~^-~PZ-2- - ill/2 


2. 


and  substituting  these  interface  pressures  into  the  2  momentum  equations 
results  in 


~  -  n  _  At 

U(i-l/2,  j-1/2)  “  U( i-1/2 ;  j-1/2)  =  A  n 


PLn  -  PRRn 


Ar. 


where 


or 


k  =  i-1/2,  j-1/2 


2n  At  r  , lo  Dy 

4U  =  — mr1 — i[PL  -1™3 

k 


and 


n 


n  \ 
PABOVE  1 


„  n  At  /PBLO  -  PABOVE 

^  -  \  =  —  [ - IT - j 
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25 
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where  (x)  and.  (•)  refer  to  the  two  different  materials  and  f  is  the  factor 
to  multiply  times  the  volume  of  the  total  cell  to  calculate  the  volume 
occupied  by  (x)  material.  The  factor  f  is  calculated  from  the  equation 
of  state,  where  we  iterate  on  the  densities  until  the  pressures  of  each 
material  are  the  same. 


The  solution  of  the  momentum  equations  provide  no  difficulties,  however, 
the  solution  to  the  energy  equation  requires  the  velocities  at  two  different 
time  steps. 

We  have  chosen  to  make  two  passes  through  this  routine,  the  first  pass 
to  integrate  the  momentum  equations,  and  formulate  the  interface  velocities 
(using  the  old  velocities  for  their  contributions  to  the  work  term)  and  the 
second  pass  to  bypass  the  momentum  equations,  and  just  compute  the  new  inter¬ 
face  velocities  for  their  contribution  to  the  work  term. 


Another  choice  might  be  to  solve  the  equations  in  one  pass  through, 
looking  ahead  two  cells  above  and  two  cells  to  the  right. 

As  an  example,  we  will  look  at  the  energy  conservation,  say,  in  the 
axial  direction.  The  radial  direction  would  be  very  similar. 

Since  we  have  dropped  the  ti'ansport  terms,  our  integration  of  the 
momentum  and  energy  equations  have  not  been  advanced  to  time  (n+l).  As 
customary,  we  designate  the  FHASE  1  velocities  and  energy  as  u,  v  and  I. 


and 


/■>-« 

v 


j-1/2  "  Vj-i/2  +  pn 


At 


j-1/2 


rPn  Pn 
J-3/2  "  j+l/2 
2  Ay, 


At  P 


n 


J-1/2 


=  I 


j-1/2 

j 


J-1/2 


p^-l/2 


'j-3/2  ~  Vj -1-1/2 


2  Ay 


j 


n 


v  , ,  :  Vi/? 

j-3/2  2. 


n 


V  VJ+l/2  *  V-l/2 

>1/2  '  2. 


where 
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Before  entering  PHI,  where  the  quantities  are  at  time  n,  the  total 
energy  of  the  system  (again,  we  are  referring  to  the  axial  direction  only) 


En  -  T  “ssj-y2  *  i(vi/a)2. 


and  the  total  energy  at  the  end  of  Phase  1  is  then 


omax  r*~  t~  \?i 

=  5  MASSj-l/2LIj-V2+'Yj-l/2). 


the  total  change  being  A  E  =  En  -  E  should  be  equal  to  0.  for  energy  con¬ 


servation. 


JMWC  fn 

*  *  *  £  ““W  [W  ■  b-l/2 

the  A  kinetic  terms  can  be  represented  by 


•VJ'1/22 !  Vj'1/2j  [Vj-V2  -  b-1/2 


Vj-l/2  (Vj-l/2  '  Vj-l/2/ 


r  n  ~  -  /n  ~ 

*  E  ■  2  tMXXJ-l/2  [b-1/2  -  b-l/a  +  b-l/2  (>l/2  -  Vj-l/2)_ 

■  EX  mass  [-  (Vj&iZtflg) 

j=l  j-1/2  I  _n  \  2Ay,  / 


At  Pj-l/2  f  Vj-3/2  ~  Vj-i 
n  \  2Ay 

Pj-1/2  J 


(Pn  Pn 

At  "3/2  3+1/2, 


j'l/2  Vo-1/2 


OMAX  MAS3  /p  r  „  n  . 

At  S  pJ_1/22  t  W  b-3/2  +  PM/2  V/* 
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Pj"l/2  Vj-l/2  +  Pj+l/2  Vj-l/2 


(A) 


At 

2 


jMAX  .  p  v  r 

E  n  (r  _  r2  )  Pn  v 

0=1  \  i  i-V  L  o-1/2  > 


n 

3/2  +  0-3/2 


V0-l/2 


"  Pj+l/2  Vj-l/2  "  Pj-l/2  V0+l/2] 

Thus  the  last  two  terms  in  j  being  cancelled  by  the  first  two  terns 
in  j+1.  Now  by  prescribing  the  proper  boundary  conditions,  we  will  have 
exact  energy  conservation  for  the  entire  grid. 


EXAMPLE: 
For  J  a  1 


Thus  we  have  non-cancellation  of  the  first  two  and  last  two  terms. 

For  our  first  example,  assume  the  bottom  boundary  is  reflective. 
Referring  to  Eq.  (A)  we  have  two  terms  that  will  not  be  cancelled  as  j 
increases,  these  terms  are 

*1/2  ?-l/2  +  P-l/2  ' 

We  set  the  pressure  of  the  mirror  cell 


^P-l/2^  “  Pl/2 


(which  docs  not  imply  that  v^yg  ~  0»)  The  other  condition  which  does  lead 
to  these  two  terms  cancelling  is  that  v  =  -  v^,. 
would  be  applied  for  the' top  boundary  to  be  reflective. 


A  similar  treatment 


f 


js  I 
>  8 


I  i 


w  t 


I * 

h  ' 

I  5 
2?  ? 
5  } 

1  i 
| 

;  ( 


P  2 
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New,  however,  if  we  assume  that  the  bottom  boundary  is  transmittive, 
our  boundary  conditions  are  then  that  ^J2  ~  raeaas  that 

Pn  -  Pn 
-1/2  "  r3/2  • 


The  condition  on  the  velocity  is  that  v  ^y^  =  v^yg 
with  the  first  two  terms  P^yg  v±/2  +  P3/2  Vl/2‘ 


Now  this  leaves  us 
This  term  then  is  adding 
or  subtracting  energy  to  the  system  (depends  on  sign  of  velocity).  To  com¬ 
pensate,  or  a  better  word  to  use  might  be  to  keep  the  books  straight,  we  also 
add  this  term  to  the  quantity  called  Eth. 

Eth  is  defined  as  the  total  energy  at  time  =0.,  less  the  energy  lost 
by  mass  leaving  the  grid  +  the  energy  added  if  negative  interval  energies 
appear  in  the  transport  phase  ±  the  energy  loss  or  gain  at  the  transmittive 
boundary  conditions  in  PHI. 

A  similar  prescription  would  apply  for  the  top  boundary  being  trans¬ 
mittive.  The  conservation  of  energy  in  the  radial  direction  follows  the  same 
logic  and  will  net  be  repeated. 

The  term  subtracted  from  Eth  for  the  boundary  at  the  right  is 


P(k)  +  P(cell  to  the  left) 


uOO  ri4  nAtW(0) 


and  the  top  is 


■ooV feudal T  n(r* . 


and  the  bottom,  if  transmittive,  is 

P(k)  h  P(cel.l  above)  ,2  2  ,.x 

-1 - t. - v(k>  n(ri  -  ri-i)4t<-5) 

and  is  added  to  ETH.  K  (in  the  above  equations)  refers  to  the  border  cell. 

The  left  boundary  (axis  of  symmetry)  is  always  reflective,  the  bottom 
may  be  reflective  or  transmittive  and  the  top  and  right  are  always  transmittive. 

Rewriting  Eq.  (l),  the  mass  transport  equation  in  finite  difference 
form  results  in 


* 
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n+1  n 

p(k)  :  p(k>  _  ri-i  pi-i  Vi  riPiui  ,  p.j-i  vi-i  -  p.i 


ri-4  iri 


ri_>  Ari 


where 


-  V(h)  V) 

“O)  -a. 

J  0-1 


z  2  ? 

where  A  for  all  j  =  -  r^  ^  ,  and 


V(k)  =  volume  of  cell  k  =  2 it  r±  K  Ar^  Az^ 


multiply  both  sides  of  Eq.  (7)  by  r±  results  in 


V/,  \  r.  =  2nr.  AZ  .  r.  ,  Ar. 
(k)  l  l  j  x-f  x 


V/,  \  r.  =  A.  r.  i  Ar. 
(k)  l  x  !-£  i 


where  A  =  area  in  the  direction  perpendicular  to  the  Z  axis.  And  similarly, 
multiplying  Eq.  (7)  by  r^  ^  results  in 

V)  ri-i  -  2«i-i  “j  ri-i  iri 


Vx  x  r.  =  A.  .  r.  ,  Ar. 
(k)  l-l  i-I  i-£  i 


Solving  Eqs.  (8)  and  (9)  for  r.  ,  Ar.  and  substituting  their  values  into 

.  1— g  X 

Eq.  (6)  results  in 


n+1  n 


1  /  z  z  r  r 

77 -  (A  .  p  v  -  A  p  v  +  A.  ,p .  nu.  ..  -  A.p.u.  ) 

v(k)  J'1  +1  J-1  J  ■) J  1-1  '-1 1-1  11 1 


k 

k+1 

.....  Ax 

r 

1  -  A  _ 

ii 

- v—— 

i 
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The  mass  to  move  across  i  is  between,  i  and  ii  where  A  =  i  -  ii 
thus  A  -  uAt  where  "u  is  the  weighted  velocity  at  A*  Using  the  first 
two  terms  of  the  Taylor  series  at  a  distance  of  -A  '  from  i,  we  expand 


Ax 


If  u^)  +•  u(k+1)/2,  >  0  use  otherwise  use  P(k+1)  in  the 

calculation  of  the  mass  flux.  The  density  (p)  is  the  total  mass  (x  and  dot) 
over  the  volume  of  the  cell. 


Mass,  both  components  of  momentum,  and  the  energy  across  all  four 
sides  of  the  cell  for  both  materials  are  calculated.  By  conserving  both 
axial  and  radial  momentum  and  the  total  energy,  the  new  velocities  are 
calculated  and  the  new  internal  energy  is  then  the  difference  between  the 
total  and  the  kinetic.  Thus,  up  to  this  point,  we  have  calcaulted  the  mass 
fluxes,  now  we  must  determine  (for  a  mixed  cell)  how  much  of  each  material 
to  move.  Three  possible  situations  concerned  with  two  materials  arise. 

1.  Material  moving  from  a  non-mixed  cell  to  a  mixed  cell.  This 
presents  no  difficulty  or  modification. 

Example  (non-mixed  to  mixed) 


Mass  flow  js  from  cell  1  to  cell  2. 


AM  =  p1  U  A  At 
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AM  =  AM 
AM  =  0 

where  =  density  of  x  material  in  cell  1. 


2.  Material  moving  from  a  mixed  cell  to  a  non-mixed  cell  is  calculated 
as  follows:  The  acceptor  material  from  the  donor  cell  is  moved 
to  the  acceptor  cell.  If  the  flux  is  such  that  this  will  more 
than  empty  the  acceptor  material  from  the  donor  cell,  the  excess 
is  removed  by  assigning  it  to  the  other  material. 


Example  (mixed  to  non-mixed) 


Mass  flow  is  from  cell  1  to  cell  2. 

AM  =  p1  U  A  At  where  p1  is  the  total  density  of  both  materials 
in  cell  1  if  AM  >  M1. 


AM 


and 


if 


AM  £  M 


AM  =  AM 


and 


AMx  =  0 


3*  Material  moving  from  a  mixed  cell  to  a  mixed  cell  requires  some 
modification  in  order  to  keep  the  material  interface  defined  in 
a  single  mixed  cell.  The  prescription  of  recipe  if  you  like, 
is  that  each  material  flux  is  weighted  by  the  fraction  of  its 
mass  to  total  in  the  acceptor  cell,  rather  than  the  donor  cell. 

Example  (mixed  to  mixed) 

1  2 


x 


x 
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Mass  flow  is  from  cell  1  to  cell  2. 

1  -  1 

AM  -  p  U  A  At,  where  p  is  the  total  density  of  both  materials 
in  cell  1.  Then 


and 


2  2 
M  +  M 
x 


AM 


AM  =  — 5  AM 

M  +  M 
x 


Note:  The  superscripts  refer  to  zone  number  of  the  subscript 
to  material  number. 


Several  techniques  are  available  for  calculating  the  specific  internal 
energy  of  a  mixed  cell. 


The  scheme  as  reported  in  the  listings  of  TOIL  is  as  follows.  The 
specific  internal  energy  for  each  material  is  proportional  to  the  specific 
total  energy  of  that  material  (the  total  specific  energy  of  the  cell  plus 
that  which  is  transported  in  .less  the  amount  transported  out). 


Where  the  (~)  tilda  refers  to  the  velocities  and  specific  internal  energy 
after  (PHl). 

AM  =  total  mass  of  cell  ulus  that  which  is  transported  in  less 
x 

the  amount  transported  out  for  the  x  material. 

AM  =  similar  term  for  the  dot  material. 

Then  the  new  internal  energy  for  the  mixed  cell  is 

«  -  AE.  +  iEx  -  i  (>ti  +  VL)  (tMx  +  «.  >  • 


n+I 

?<x 


M 


tn+l 


3h 


and 
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C.  NORMAL  INPUT  FOR  THE  TOIL  CODE 

An  (*)  designates  that  the  work  is  fixed  point  (a  2  in  Column  l) 
although  all  words  are  loaded  via  card  routine  in  floating  format.  (A  **, 
double  asterisk  signifies  this  is  last  card  of  the  set.) 

lst_Set- - Column  .1-3 — contains  N  (the  number  of  BCD  cards  to  follow  (format 
13)  N  ECD  cards. 

2nd  Set 

Name  Description 

N7  Binary  tape  dump  number. 

PK  array  PK(l)  =  problem  number 

PK(2)  =  cycle  number  to  start  problem 
PK(3)  =  -1>  for  restart  or  starting  from  the 
TCLAM  tape 

PK(3)  =  0,  starting  problem  at  t  *  0,  via 
subroutine  SETUP. 


LOC 

Name 

Description 

14 

FFA 

See  usage  as  described  in  OIL  report. 

15 

FFB 

See  usage  as  described  in  OIL  report. 

24 

DMIN 

-6 

~  10  energy  check  AE/E/cycle. 

25 

FeF 

A  .03,  used  in  iteration  routine  for  calculating 
pressures  in  a  mixed  cell. 

27 

CVIS 

Bottom  boundary  condition.  If  <  0  transmittive 
otherwise  reflective. 

*47 

il 

Active  grid  counter  in  the  i  direction  (=  the 
i  value  of  the  right  most  cell  (that  has  internal 
or  kinetic  energy) +  2). 

*48 

i2 

Similar  to  il  but  for  the  j  direction. 

LOC 

*57 

**282 


3rd  Set 
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LOC 

Name 

Description 

*51 

HI 

~  20,  the  maximum  number  of  iterations  allowed 
for  calculating  the  pressure  of  a  mixed  zone. 

77 

SBOUND 

Same  value  as  for  OIL  ~  1.0. 

71 

REZPCT 

PH2  routine  always  will  check  for  the  amount  of 
material  (TOZONE)  leaving  the  top  or  right 
boundaries.  It  may  trigger  RBZONE  (sets  REZ  =  1. ) 
At  the  completion  of  PH2,  if  REZ  =  l.  a  further 
check  is  done,  using  REZFCT  (if  =1.)  code  will 
call  the  subroutine  REZONE,  otherwise  it  will 
ignore  the  flag  set  in  PH2. 

75 

TOZONE 

The  mass  flux  at  a  interior  free  surface  is  set 
to  0.  unless  the  flux  produces  a  density  >  TOZONE, 
if  so  mass  is  allowed  to  move. 

82 

CABIN 

See  usage  as  described  in  the  OIL  report. 

36 

GAMMA 

(For  dot  material. ) 

87 

GAMMA 

(For  x  material. ) 

105 

Z(105) 

Fraction  of  stability  for  early  times  if  the  in¬ 
itial  energy  is  primarily  internal,  rather  than 
kinetic  (~  .05). 

106 

z(io6) 

Factor  to  increase  Z(l05)/cycle  to  build  up  its 
value  to  the  normal  value  located  in  Z(l39)« 

107 

Z(107) 

Pmin  Minimum  density  of  x  material  allowed  in 
any  cell. 

■108 

z(l08) 

Pmin  Minimum  density  of  .  material  allowed  in 
any  cell. 

ill 

Z(lll) 

Density  of  (.)  material  to  add  on  to  target  for 
REZONE  (hypervelocity  type  calculations). 

112 

Z(112) 

Initial  (Z  component)  projectile  velocity  in 
cm/shake. 

113 

Z(113) 

e  (epsilonics)  for  emptying  the  bottom  cells  of 

the  projectile  up  until  the  reflected  shock 
reaches  the  bottom  surface  of  the  projectile.. 


LOC 


Name 


Description 


115 

"O 

O  X 

116 

?0 

117 

X 

a 

118 

• 

a 

119 

*0 

120 

Eo 

121 

bx 

122 

b’ 

123 

AX 

124 

A’ 

125 

V* 

s 

126 

V' 

s 

127 

EX 

s 

128 

E* 

s 

129 

X 

a 

130 

a’ 

131 

3* 

132 

3' 

133 

BX 

134 

B* 

138 

Z(138) 

139 

Z(139) 

143 

Z(l43) 

The  superscripts  refer  to  the  material.  The 
definitions  and  numerical  values  for  different 
material  are  the  same  as  in  the  OIL  report. 


The  superscripts  refer  to  the  materia}  the  de¬ 
finitions  and  numerical  values  for  the  different 
materials  are  the  same  as  in  the  OIL  report. 


Minimum  density  that  a  cell  must  have  such  that 
a  stability  check  will  be  performed  on  it. 

Fraction  of  stability  (~  .5)- 

=  minimum  density  of  the  dot  (.)  material  al¬ 
lowable  to  transport  across  a  cell  or  to  remain 
in  a  cell  (~  10" 3  p^). 
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LOC 

Name 

144 

Z(l44) 

145 

Z(l45) 

146 

Z(l46) 

148 

c°  1 

149 

A  > 

150 

e 

**3 

nr 

4 

PRINTS 

5 

PRTNTL  \ 

6 

DUJPT7 

7 

CSTOP 

J 


Description 

=  similar  term  for  the  x  material,. 

=  e  (epsilonics)  on  tue  specific  internal  energy. 
If  Aix  or  AiD  <  Z(l45),  Aix  or  AiD  is  set  to  0. 
and  the  books  are  balanced. 

=  e  (epsilonics)  on  the  2  velocity  component.  If 
|  u|  or  |  v|  <  Z(l46),  u  or  v  are  set  to  0.  and  the 
books  are  balanced. 

C  =  CQ  +  APe 

Where  the  units  of  C~  and  A  are  10^  cm/sec  and 
P  is  in  megabars.  CDT  routine  converts  (c) 
speed  of  sound  to  cm/shake. 


See  usage  and  definitions  as  described  in  the 
OIL  report. 


If  one  uses  the  subroutine  SETUP  for  generating  the  initial  con¬ 
figuration,  the  following  data  cards  must  be  added  to  the  3rd  set,  and  a 
4th  set  must  be  added,  usually  duplicate  the  last  card  of  the  3rd  set. 
Subroutine  SETUP  implies  certain  restrictions  as  stated: 


1.  Constant  DX  and  constant  DY, 

2.  The  projectile  is  a  right  circular  cylinder, 

3*  The  projectile  has  kinetic  (Z  component  only)  energy  only. 


IX 

Name 

Description 

ro 

CD 

\ji 

PK(4) 

Set  =  1. 

286 

PK(5) 

Right  boundary  of  projectile  (i). 

28? 

pk(6) 

Bottom  (j)  +  1  of  projectile. 

288 

PK(7) 

Top  (j)  of  projectile. 

4o 


LOC 

Name 

Description 

289 

PK(8) 

=  1. 

290 

PK(9) 

Right  (i)  boundary  of  target. 

291 

PL(IO) 

Bottom  (j)  +  1  of  target. 

292 

PK(ll) 

Top  (j)  of  target. 

23389 

DX(1) 

DX,  to  be  used  for  all  (i). 

23489 

DY(1) 

DY,  to  be  used  for  all  (j). 

1 

PROB 

The  problem  number. 

*33 

iMAX 

The  maximum  number  of  zones  in  the  i  direction. 

*35 

jMAX 

The  maximum  number  of  zones  in  the  j  direction. 

NOTE:  (iMAX) (jMAX)  must  be  <  4499. 

*57 

N7 

The  binary  tape  number. 

4l 


D.  TOIL  (TWO  MATERIAL) 


Symbol 

Log 

No.  of 
Words 

Units 

Description 

AiD 

5253 

4500 

jerks/g 

Specific  internal  energy  in 
jerks/g  of  cell  K  (for  .  materia' 

AiX 

9753 

4500 

jerks/g 

Specific  internal  energy  in 
jerks/g  of  cell  K  (for  X  materia! 

AM 

14253 

130 

many 

Equivalence!  to  DMASL  in  PH2  and 
used  for  partial  editing  in  EDIT 

AMD 

14383 

4500 

grams 

Mass  in  grams  of  cell  K  for  ( . ) 
material. 

AMDM 

23 

1 

grams 

Not  used  in  TOIL.  Set  =  minimum 
( . )  particle  mass/2,  in  TCIAM. 

AMK 

267 

15 

many 

Used  in  EDIT,  also  equivalenced 
to  UR(l6). 

AMX 

18883 

4500 

grams 

Mass  in  grams  of  cell  K  for  (X) 
material. 

AMXM 

22 

1 

grams 

Not  used  in  TOIL.  Set  =  minimum 
(X)  particle  mass/2,  in  TCLAM. 

AREA 

23383 

1 

- 

Not  used. 

BBOUND 

74 

'  1 

- 

Not  used. 

BIG 

23384 

1 

- 

Not  used. 

BOUNCE 

23385 

1 

- 

Not  used. 

CABLN 

82 

1 

- 

Same  definition  as  in  OIL  code. 

CSTOP  • 

7 

1 

** 

Cycle  number  at  which  problem 
will  stop,  edits  and  writes 
dump  tape. 

CVIS 

27 

1 

If  -,  bottom  boundary  is  trans- 
mittive,  otherwise  reflective. 
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No.  of 

Symbol  Loc  Words  Units  Description 

ECK  76  1  -  Energy  check  ~ 

ETHn-En  _  ETHn"m-ETHn~m 

ETHn  ETHn~m 

M 

ETH  13  1  jerks  Total  energy  of  system  less  any 

that  leaves  or  adjustments  at 
transmittive  grid  boundaries. 

FD  23590  1  -  Not  used. 

FEF  25  1  e  factor  in  ES. 

FFA  14  1  -  Upper  limit  for  stability  and  to 

calculate  At  only  if  CABLN  =  0. 

FFB  15  1  Lower  limit  for  stability  and  to 

calculate  At  only  if  CABLN  =  0. 

FLEFT  252  100  grams  Used  in  PH2  as  X  mass  at  left 

boundary. 

FS  2359-1  1  -  Used  in  PHI,  PH2,  independent 

of  each. 

FX  23592  1  -  Not  used. 

GAM  10  1  -  Not  used. 

GAMC  452  1  many  Equivalenced  to  PL  of  PR. 

GAMD  11  1  l./(7*“l. )  Used  for  gamma  law 

equation  of  state. 

GAMX  12  1  1. /(7X-I. )  Used  for  gamma  law 

equation  of  state. 

GMADR  88  1  y./{y.-l)  Calculated  but  not  used. 

GMAX  '85  1  -  Maximum  gamma. 

GMAXR  89  1  7X/(yX-l. )  Calculated,  but  not 

used. 

I  37531  1  -  Index  in  X  direction. 

II  37532  1  -  Wox-king  index,  used  in  INPUT. 
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Symbol 

Loc 

No.  of 
Words 

Units 

Description 

IMAX 

38 

1 

- 

Maximum  number  of  zones  in  the 

X  direction. 

IMAXA 

3lr 

1 

- 

=  iMAX  +  1,  never  used. 

IN 

37533 

J. 

- 

Not  used. 

IR 

37534 

1 

- 

Not  used. 

IWS 

37535 

1 

- 

Used  as  working  storage  in  INPUT 
and  CDT. 

IWSA 

37536 

1 

- 

Not  used. 

IWSB 

37537 

1 

1 

- 

Not  used. 

IWSC 

37538 

1 

- 

Not  used. 

IW1 

37539 

130 

many 

Equivalenced  to  DENRG. 

IXMAX 

42 

1 

— 

Calculated  as  iMAX  =  2  in  TCLAM, 
never  used.  SETUP  does  not 
calculate  it. 

IZ 

7 

150 

many 

Fixed  point.  Block  equivalenced 
to  Z. 

11 

47 

1 

- 

Active  grid  counter  in  X  direction- 
maximum  value  =  iMAX. 

12 

48 

1 

- 

Active  grid  counter  in  Y  direction; 
maximum  value  =  jMAX. 

13 

49 

1 

- 

Not  used. 

14 

50 

1 

- 

Not  used. 

J 

37 669 

1 

- 

Index  in  Y  direction  (temporary). 

jMAX 

35 

1 

- 

Maximum  number  of  zones  in  the 

Y  direction. 

JMAXA 

36 

1 

- 

=  jMAX  +  1,  never  used. 

JN 

37670 

1 

- 

Not  used. 

JP 

37671 

1 

- 

Not  used. 

JR 

37672 

1 

- 

Not  used. 

Symbol 


No.  of 
Words 


Description 


Symbol 

Loc 

No.  of 
Words 

K 

37673 

1 

KDT 

4l 

1 

kMAX 

37 

1 

kMAXA 

38 

1 

KN 

37674 

1 

KP 

37673 

1 

KR 

37676 

1 

KRM 

37677 

1 

L 

37678 

1 

M 

37679 

1 

MA 

37680 

1 

MB 

37681 

1 

MC 

37682 

1 

MD 

37683 

1 

ME 

37604 

1 

MZ 

37683 

■1 

N 

37686 

1 

NC 

30 

1 

ND 

40 

1 

NIMAX  . 

45 

1 

NJMAX 

46 

1 

NK 

37687 

1 

NKMAX 

37688 

1 

NK1 

37689 

1 

Index  of  center  of  cell,  defined 
as  =  (j-i)  iMAX  +  i  +  1. 

Flag  in  CDT  to  signal  print  re¬ 
work  DT  has  changed. 

=  Umax)  Qmax)  +  1. 

=  kMAX  +  1. 

Not  used. 

Index  in  PH2  (temporary). 

Not  used. 

Not  used. 

Index  (temporary). 

Index  (temporary). 

Index  (used  in  SETUP). 

Index  (used  in  SETUP). 

Index  (used  in  SETUP). 

Index  (used  in  SETUP). 

Index  (used  in  SETUP). 

Index  (used  in  SETUP). 

Index  (temporary). 

Fixed  point  value  of  cycle  number 
Used  temporarily  in  PH2. 

=  iMAX/2  calculated  in  REZONE. 

=  jMAX/2  calculated  in  REZONE. 
Index  in  EDIT. 

Not  used. 


NK1 


Index  in  EDIT. 


Loc 


No.  of 
Words 


Units 


Description 


n 

o 


ynibol 


NMAX 

39 

1 

NO 

37690 

l 

NOD 

h3 

l 

NOPR 

kk 

l 

NPC 

31 

l 

NPR 

28 

1 

NPRi 

29 

1 

NR 

37691 

1 

NRC 

32 

l 

NRM 

62 

1 

N1 

51 

1 

N10 

60 

1 

Nil 

6.1 

1 

N2 

52 

1 

N3 

53 

1 

N4 

51* 

1 

N5 

55 

l 

N6 

56 

l 

N7 

57 

1 

N8 

58 

1 

Flag  for  stability  check  in 
radial  direction  (PIC  or  OIL). 

Not  used. 

Not  used. 

Not  used. 

Number  of  cycles  between  energy 
checks. 

Not  used. 

Not  used. 

Identification  of  routine  when 
a  dump  is  called. 

Used  as  flag  for  advancing  active 
grid  counters  in  PHI  and  PH2. 

For  radiation  option,  is  the 
maximum  number  of  radiation 
cycles  per  hydro. 

Maximum  number  of  iterations  for 
mixed  cell  pressure. 

=  i  of  zone  controlling  time  step. 

=  j  of  zone  controlling  time  step. 

Not  used. 

Set  =  0  in  TCLAM. 

Not  used. 

Not  used. 

Not  used. 

Binary  tape  number. 

Not  used. 


N9 


59 


1 


Not  used. 


hi 


Symbol 

Loc 

No.  of 
Words 

Description 

our 

23593 

1 

Not  used. 

P 

23594 

4500 

Pressure  of  cell  K. 

PABOVE 

28094 

1 

=  [P(K)  +  P(cell  above )]/2.  PHI. 

PBLO 

28095 

1 

jerks/ 

CRp 

=  [P(K)  +  P(cfcll  below )]/2.  PHI. 

PIDTS 

28096 

1 

many 

=  l./nAtAy  in  PHI;  l./nAt  in  PH2 

PIDY 

8 

1 

- 

it. 

PK 

282 

15 

many 

Used  for  inputing  starting  data. 

PL 

452 

200 

many 

Used  in  PHI  and  PH2. 

PPABOV 

28097 

1 

- 

Not  used. 

PR 

452 

200 

many 

Used  in  PHI  and  PH2. 

PRINTL 

5 

1 

cycles 

Number  of  cycles  between  long 
prints. 

PRINTS 

4 

1 

cycles 

Number  of  cycles  between  short 
prints. 

PROB 

1 

1 

- 

Problem  number. 

PRR 

28093 

1 

jerks/ 

cm3 

=  [P(K)  +  P(cell  to  right)]/2. 
PHI. 

PUL 

28099 

1 

- 

Not  used. 

QDT 

28100 

1 

- 

Not  used. 

QK 

297 

15 

g-cm- 

shake 

Axial  momentum  in  selected  angle 

QOOOFL 

28107 

1 

- 

Not  used. 

RADEB 

69 

1 

- 

Not  used. 

RADER ‘ 

67 

1 

g-  cm- 
shake 

Total  positive  radial  momenta  fo 
X  material. 

RADET 

68 

1 

g-cm- 

shake 

Total  positive  axial  momenta  for 
X  material. 

RC 

28101 

1 

cm 

=  [X(i)  +  X( i- 1)3/2.  in  PHI. 

Symbol 


Loc 


No.  of 
Words 


Units 


Description 


REZ 

28102 

1 

- 

If  mass  -leaves  top,  right  or 
bottom,  REZ  set  >  0. 

REZFCT 

71 

1 

- 

If  REZ  (trigger  in  PH2)  >  0  and 
REZFCT  >  0  PH2  calls  REZONE. 

RHO 

28103 

1 

- 

Not  used. 

RL 

28104 

1 

- 

Not  used. 

RR 

28105 

1 

cm 

=  [x(i)  +  X(i+l)]/2.  in  PHI. 

RSTOP 

72 

1 

- 

Not  used. 

SBOUND 

77 

1 

- 

Factor  in  velocity  weighting  PH2. 

SHELL 

73 

1 

- 

Not  used. 

SIG 

28106 

1 

cm 

Minimum  AX  or  AY  in  CDT  routine. 

SIGC 

551 

100 

many 

Used  in  PHI  and  PH2. 

SN 

65 

1 

1 

- 

Not  used. 

SWITCH 

28103 

1 

- 

Not  used. 

SI 

90 

1 

- 

Not  used. 

SIO 

99 

1 

- 

Not  used.  ■ 

S2 

91 

1 

- 

Not  used. 

S3 

92 

.  1 

- 

Not  used. 

S4 

93 

1 

- 

Not  used. 

S5 

94 

1 

- 

Not  used. 

S6 

95 

i 

- 

Not  used. 

S7 

96 

1 

- 

Not  used. 

S8 

97 

1 

- 

Not  used. 

S9 

VO 

CO 

1 

- 

Not  used. 

T 

84 

1 

shake 

t  =  t  +  At. 

Loc 


No.  of 
Words 


Units' 


Description 


Symbol 


TAB 

252 

15 

- 

Tangent  bf  12  selected  angles 
(EDIT). 

TABLM 

281C9 

1 

- 

Not  used. 

TAU 

28110 

100 

2 

cm 

TAU(i)  =  Jt(X?  - 

TAUDTS 

28210 

1 

2 

cm  - 

shake 

=  TAU(i)  *  DT.  (PHI) 

TAUDTX 

28211 

1 

- 

Not  used. 

THETA 

652 

4500 

- 

Eauivalenced  to  DKE  array. 

TMDZ 

16 

1 

grams 

=  total  (.)  mass,  (if  TCLAM 
generates  the  data. ) 

TMXZ 

17 

1 

grams 

=  total  (X)  mass,  (if  TCLAM 
generates  the  data.) 

TMZ 

9 

1 

grams 

Total  mass  (X  +  . ). 

TOZONE 

75 

1 

g/cm^ 

If  mass  flux  (across  free  surface) 
produces  p  <  TOZONE,  flux  set 
to  0.  PH2. 

TRAD 

63 

1 

shake 

At  radiation  (not  used  in  this 
version). 

TXMAX 

19 

1 

cm 

2.  *  X(iMAX)  never  used. 

TYMAX 

20 

1 

cm 

2.  *  Y(jMAX)  never  used. 

U 

28212 

4500 

cm- 

shake 

Radial  velocity  component  of 
cell  K. 

UK 

'32712 

1 

- 

Not  used. 

UL 

252 

200 

many 

Arrays  in  PHI,  PH2  of  twice  (jMAX). 

UR 

252 

200 

many 

Arrays  in  PHI,  PH2  of  twice  (JMAX). 

URR 

32713 

1 

2 

cm  - 

shake 

[U(K)  Xi-l/2  +  U(K+L)  Xi+l/2]/2. 

UT 

32714 

1 

- 

Not  used. 

UTEF 

32717 

1 

- 

Not  used. 

UU 

32715 

■  1 

- 

Not  used. 

Symbol 

Loc 

No.  of 
Words 

Units 

Description 

X 

152 

100 

cm 

X(i)  =  right  boundary  of  cell  i. 

XL 

3726>f 

130 

- 

Used  temporarily  in  EDIT  and  PH2. 

XLF 

3239^ 

1 

- 

Not  used. 

XMAX 

18 

1 

cm 

X(iMAX). 

XN 

37395 

1 

- 

Not  used. 

XNRG 

6h 

1 

- 

Not  used. 

XR 

37396 

1 

- 

Not  used. 

XX 

151 

101 

cm 

XX(i)  =  X(i-l)  not  used. 

XI 

78 

1 

- 

Not  used. 

X2 

79 

1 

- 

Not  used. 

Y 

5153 

100 

cm 

Y( j ),  the  top  dimension  of  cell  K 

YAMC 

351 

100 

many 

Used  in  PHI  and  PH2. 

YL 

37397 

130 

many 

Used  temporarily  in  PH2  and  EDIT. 

YLW 

37527 

1 

- 

Not  used. 

YN 

37528 

1 

Not  used. 

YU 

37529 

1 

- 

Not  used. 

YY 

5152 

101 

cm 

YY(2)  =  Y(l)  not  used. 

Y1 

80 

1 

- 

Not  used. 

Y2 

81 

1 

- 

Not  used. 

Z 

1 

150 

many 

Definitions  have  been  made. 

37530 


1 


Not  used. 


Z  BLOCK 


Location 

Symbol 

Units 

- - 

| 

Description 

Z(l) 

PROB 

- 

Problem  number  (if  positive,  this  is  an  OIL  rui 
if  negative,  this  is  a  PIC  run. 

Z(2) 

CYCLE 

- 

Cycle  number  (floating  point  value). 

z(3) 

DT 

shake 

j  (\t  hydro  = 

tn  -  t"-1. 

z{b) 

PRINTS 

- 

Cycle  frequency  for  short  print. 

iSl 

PRINTL 

- 

Cycle  frequency  for  long  print. 

Z  (6) 

DUMPT7 

- 

Cycle  frequency  for  binary  tape  dumps. 

Z(7) 

CSTOP 

- 

Cycle  number  at  which  problem  stops. 

Z(8) 

PIDY 

- 

»  *  »  3.1^15927. 

Z  (9) 

TMZ 

grams 

Total  (X  + 
TCALM. 

.)  mass  at  t  =  0  (calculated  in 

Z(10) 

GAM 

- 

Not  used. 

Z(ll) 

GAMD 

- 

1./7--1) 

1  Computed  in  INPUT. 

Z(12) 

GAMX 

- 

l./(7X-l) 

1 

■Z(13) 

ETH 

jerks 

Total  energy  (computed  in  TCLAM  for  t  =  0). 
Changed  in  PHI  at  transmittive  boundaries  and 
in  PH2  if  mass  leaves  the  system,  and  by 
radiation  flow  out  of  the  system. 

Z(l4) 

FFA 

- 

Upper  limit  for  stability  and  to  calculate 

At,  only  if  CABLN  =  0. 

Z(15)  . 

FFB 

- 

Lower  limit  for  stability  and  to  calculate 

At,  only  if  CABLN  =  0. 

z(l6) 

TMDZ 

grams 

Total  (.)  mass  (t  =  0)  calculated  in  TCIAM. 

Z(17) 

TMXZ 

grams 

Total  (x)  mass  (t  =  0)  calculated  in  TCLAM. 

z(l8) 

XMAX 

cm  ■ 

=  X(iMAX). 

Location 

Symbol 

Units 

z(i9) 

TXMA.X 

cm 

Z(2 0) 

TYMAX 

cm 

Z(21) 

AMDM 

grams 

Z(22) 

AMXM 

grams 

Z(23) 

DNN 

- 

Z(24) 

DMIN 

- 

Z(25) 

FEF 

- 

Z(26) 

DTNA 

shake 

Z(27) 

CVIS 

- 

Z(28) 

KPR 

- 

Z(29) 

NPRi 

- 

z(30) 

NC 

- 

z(3i) 

NPC 

- 

Z(32) 

NRC 

- 

Z(33) 

iMAX 

- 

Z(3l0 

iMAXA 

- 

Z(35) 

jMAX 

- 

Z(36) 

JMAXA 

- 

z(37)  • 

kMAX 

- 

z(38) 

kMAXA 

- 

Description 


2  (XMAX)  t  =  0.  calculated  in  TCLAM. 

2  (YMAX)  t  =  0.  calculated  in  TCLAM. 

Minimum  (.)  particle  mass/2.;  calculated  in 
T2LAM. 

Minimum  (x)  particle  mass/2.;  calculated  in 
TCLAM. 

(ETH  -  E)n_NPC/ETH. 

IE  (ECK).  NOTE:  Z(l6)  >  DMIN,  problem  will 
stop  and  the  EDIT  routine  will  call  dump. 

~  .03  used  in  iteration  routine  for  calculating 
pressures  for  partial  volume. 


If  <  0,  bottom  boundary  is  transmittj ve;  other¬ 
wise  reflective  boundary. 

Index  (working  storage). 

Index  (working  storage). 

Cycle  number  in  fixed  point. 

Number  of  cycles  between  shox-t  prints. 

Index. 

Maximum  number  of  zones  in  R  direction. 
iMAX  +  1. 

Maximum  number  of  zones  in  Z  direction. 
jMAX  +  1. 

( iMAX )( jMAX )  +  1. 
kMAX  +  1. 


z(39) 


NMAX 


Total  number  of  pai’tj  cles  +  1,  generated  in 
TCLAM  for  PIC  problem  only. 


Location 


Symbol 


Units 


Description 


Location 


Symbol 


Units 


Description 


56 


Location 

Symbol 

Units 

Description 

Z(8  6) 

WSGD 

- 

7- 

Z(8?) 

WSGX 

- 

yX  and  (7MAX  -  l)  in  CDT. 

z(88) 

GMADR 

- 

7*/(7*  -  !)• 

z  (89) 

GMAXR 

yX/(yX  -  1). 

z(90) 

SI 

- 

Not  used. 

s(9i) 

S2 

- 

Not  used. 

Z(92) 

S3 

- 

Not  used. 

Z(93) 

S4 

- 

Not  used. 

z(94) 

S5 

- 

Not  used.  , 

z(95) 

s6 

- 

Not  used. 

z(96) 

S7 

- 

Not  used. 

Z(9T) 

s8 

- 

Used  in  TCLAM  only. 

z(98) 

S9 

- 

Not  used. 

z(99) 

SIO 

- 

Not  used. 

Z(100) 

grams 

Mass  thrown  away  (PH2)  continuous  transport. 

Z(101) 

jerks 

Total  energy  thrown  away. 

Z(102) 

-  • 

Not  used. 

Z(i03) 

- 

Not  used. 

Z(l04) 

jerks 

Energy  (internal)  added  to  system  when  internal 
is  set  to  0  if  I  <  0. 

z(l05) 

yes 

Fraction  of  stability  at  early  times. 

Z(106) 

yes 

(1.  +  $)  increase/cycle  until  Z(l06)  =  Z(l39)» 

Z(107) 

yes 

X  mass  cut  off  in  PH2. 

Z(108) 

yes 

.  mass  cut  off  in  PH2. 

Z(109) 

- 

Not  used. 

Location  Syir.bol 


Units 


Location 


Symbol 


Units 


Description 


2(135) 

- 

2(136) 

- 

2(137) 

- 

2(138) 

g/cra^ 

2(139) 

- 

Z(l4o) 

- 

Z(l4l) 

- 

Z(l42) 

- 

"'143) 

g/cm^ 

z(l44) 

g/cnf* 

2(145) 

jerk/g 

Z(l46) 

cm- 

shake 

2(147) 

- 

Z(l48) 

A 

109  cm- 
sec 

2(149) 

B 

- 

2(150) 

e 

-  . 

Not  used. 

Not  used. 

Not  used. 

Density  check  if  p(K)  <  Z(138)  stability 
check  for  cell  (K)  is  bypassed. 

Percent  of  instability,  used  in  CDT  if 
CABLN  <  0  «  .5. 

Not  used. 

Not  used. 

Not  used. 

Minimum  (. )  density  in  PH2  ~  10  ^  p7. 
Minimum  (x)  density  in  PH2  ~  10~^  p7. 
e  on  I  in  PHI,  PH2  ~  10~9. 
e  on  U  or  V  in  PHI,  PH2  ~  10~6. 
j  {of  pellet- target  interface)  at  t  *  0. 

C  (speed  of  sound  «*  A  +  BPe  where  A  =  C 
and  P  is  in  megabars. 


E.  TCLAM  AND  TOIL  LISTINGS 
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C 

.v 

C 

c 

iC 


c 

c 

c 


NQTEvTllE*  FOLLOWING  SET  OF  DIMENSION* 

CO!v*.ON  AND  EQUIVALENCE  ARE  TO  BE  USED  FOR  ALL 
***  TCLAM  *"**'■-  '**-+ 

DIME  »  5  I  0  K 


SUBROUTINES 


INPU0020 

INPU0030 


DIMENSION  AIX(5000) 9  AID(5000) »AMl 130) # 

1AMX(5000) 9  AMD (5000) #OX(100) #ENDD ( 2) » ITAB ( 502) u 
212(100) ?R0NE(2) 9 TAB (502) 9 TAB I (20) #TABIY (21) >TABR(20) 9 
3TABUV (20) rTABX(21) #TABY(21) #TAU(100) 9  TEMP (13) 9 


4U(5000)  pV(5000)  »XUO0) 9  XL (130) # 
5YL(130) pZ(150) »Y(100)»DY(100) 


DIMENSION 

IW1(130) 9 1W2(130) 

COMMON  2# X f TAB 9 Y 

COMMON 

AID 

9  AIMAX 

COMMON 

AMX 

#QX 

COMMON 

GYN 

#GYX 

COMMON 

IBB 

9  ID 

COMMON 

IR 

9  IRC 

COMMON 

IWSB 

9 IX 

COMMON 

J 

9  JA 

COMMON 

KF 

#KK 

COMMON 

LE 

#LI 

COMMON 

MJ 

#MN 

COMMON 

MZ 

#NPKG 

COMMON 

GOOOFL# 

RHO 

COMMON 

TABIY 

#TA(3R 

COMMON 

TAU 

9  TEMP 

COMMON 

U 

t  V 

COMMON 

WSC 

9  ViSD 

COMMON 

WSL 

9WSU 

COMMON 

XC 

9  XL 

COMMON 

PE 

9  PM 

COMMON 

PhE 

9.NPRR 

COMMON 

IWl 

9 IW2 

E  Q  U  I  V 


#AIX 

» A JMAX 

9  AM 

9  AMD 

;ENDD 

#FMX 

#GXN 

#GXX 

9 1 

9 IA 

9  IB 

9  iba 

9 16 

#11 

#IIC 

#10 

#IUV 

9IUVC 

#IWS 

9 IWSA 

#IXN 

#IXX 

9 IYN 

9 IYX 

9  JT 

9  JTM 

#K 

#KE 

#L 

9  LA 

9  LB 

»LD 

9  LX 

#M 

#MI 

#MI  J 

9  MNP 

9  MX 

#MXA 

#MXS 

#NPP 

#NT 

9  NX 

9  NY 

RONE9SLA9SLB 

#TABI 

9TA8UV 

#TABX 

9TABY 

9  TAM 

#TFMX 

9TPIDY 

#TX 

#TY 

9 WPIDY 

9  V.'S 

9  WSA 

9  WSB 

9  WSE 

#WSF 

9  WSG 

#WSI 

9WSV 

#WSX 

9  WSY 

9  WS5 

9  YC 

9  YL 

9  ymax 

9  WSR 

#TTX 

9  TTY 

»LF 

#E 

#NYY 

#DY 

9NK 

? switch 

A  L 

E  N 

C  E 

INPU0100 

INPU0120 

INPU0130 

INPU0140 

INPU01S0 

INPU0160 

INPU0170 

INPU0180 

INPU0190 

INPU0200 

INPU0210 

INPU0220 

INPU0230 

INPU0240 

INPU02SO 

INPU0260 

INPU0270 

1NPU0280 

INPU0290 

INPU0300 

INPU0310 

INPU0320 

INPU0400 

INPU0410 

INPU0420 


ULoUlVALENCE 
1 (2(4) 9  PRINTS) 9 
2(2(8) »PIDY) t 
3(2(12) »GAMX) 9 
4(2(16) »TMDZ)» 
b(2(20) »TYMAX) » 
6(2(24) »DMIN) t 
?(Z(28) »NPR) » 
8(2(32) #NRC) t 
9(2(36) tUMAXA) » 
OEQUIVALENCE 
1(2(43) 9  NOD) 9 
2(2(47)  ?  ID  » 
3(Z(51) »N1) » 
4(2(55) r N5) r 
5(2(59) »N9)i 
6(Z(63) rTRAD)  t 
7(2(67) ?RAOER) 9 
8(2(71) 9REZFCT) # 
9(2(75) rTOZONE) 9 
OEQUIVALENCE 


(Zf IZ/PROB) 9 
(2(5) iPRINTL) 9 
(Z(9) #TMZ) r 
(Z( 13) f ETH) f 
(2(17) »TMX2) t 
(2(21) »AMDM) t 
(2(25) »FEF) 9 
(Z(29)  »NPRD  9 
(2(33) »IMAX) » 
(2(37) »KMAX) 9 
(2(40) vND) 9 
(2(44) »NQPK) 9 
(Z(48) » 12) » 
(Z(52) »M2) 9 
(Z(56) »N6) 9 
(2(60) #N10) # 
(Z(64) #XNRG) 9 
(2(68) »RADLT) r 
(2(72) f RSTOP) 9 
(Z(76) »ECK) 9 
(2(79) »X2) r 


(2(2) f CYCLE) 9 
(Z(6) #DUMPT7) 9 
(2(10) #GAM) 9 
(Z( 14) »FFA) » 
(2(18) rXMAX) » 
(Z(22) »AMXM) 9 
(2(26) rDTNA) 9 
(2(30) r NC) 9 
(2(34) 9 IMAXA) 9 
(2(38) 9 KMAXA ) 9 
(2(41) »KOT) 9 
(2(45) >NlMAX) 9 
(2(49)913)# 
(Z(53) #N3) # 

( Z ( 57 ) #  N7 ) # 
(2(61)  #NH)  * 

(Z (65) #  SM ) r 
(2(69) 9RADEB) # 
(2(73) # SHELL) # 
(2(77) 9SBOUND) 9 
(2(80)  # YD  9 


(2(3) #DT) 9 
(2(7) #CST0P) # 
(Z(ll)9GAMO)9 
(2(15) fFFB) 9 . 
(Z(19)#TXMAX) 9 
(Z(23) 9  DNN ) # 
(Z(27) >CVIS) 9 
(Z(31)?NPC) » 
(Z(35) 9 JMAX) 9 
(Z(39),MMAX) 
(Z(42) 9IXMAX) 9 
(Z(46) 9 N JMAX) 9 
( Z ( 50 ) 9 14) 9 
(2(5,4)  ?N4)  # 
(2(58) #N8) 9 
(Z(62) #MRM) 9 
<Z(66) #DXM) 9 
(Z(70) #DTRAD) 9 
(2(74) 9BBOUND) 
(Z(78) #X1) 

(2 (81) 9 Y2) 9 


INPU043C] 
INPU044CJ 
INPU045d 
INPU046f[ 
INPU047CI 
INPU048(~ 
1NPU049( 
INPU050( 
IN°UObl( 
INPU052( 
INPU053( 
1NPU054( 
INPU055I 
INPU0561 
INPU057I 
INPU058 
1NPU059 
INPU060 
t INPU061 
INPU062 
INPU063 


ooooo  o  r>  oooooo  o  o  o  o  o  o  o  oooooo  oo  non 


k  ~  *  .  v'' 

•  --t ,  -Tf  K>'_  ~ 

"  *-  ‘V’  '*  ^ 

1(Z(82) #CABLN) # 

(Z(83) #  VISC) # 

• 

(Z(84) »T) » 

(Z(85),GMAX)» 

»  2(Z(86)#WSGD)» 

(Z(87) # WSGX) » 

(Z(88) »GMADR) » 

(Z(89) rGMAXR) # 

3(Z(90)#S1)» 

(Z(91)#S2)» 

(Z(92)»S3)# 

(Z(93)»S4>» 

4(Z(94) #S5) » 

(Z(95) #S6) » 

(Z(96)»S7)» 

( Z l 97 ) #S8) » 

5(Z(98) #S9) # 

(Z(99)#S10) 

EQUIVALENCE  (Z» 

IZ) » (TAB# ITAB) 

•• 

DIMENSION  PLOT (10) 

DATA  PL0T/3H  X  » 3HD0T » 3HGEN # 3HDEL/ 

CMAIN 

LAM  ******  MAIN  ****** 


CALL  SLITE  (0) 

INPUT  ROUTINE  CALCULATES  THE  ACTUAL  GRID# 
DIMENSIONS  AND  INDICES. 

10  CALL  INPUT 

PHI#  READS  IN  DATA  CARDS  FOR  THE 
PACKAGES#  PH2  CALCULATES  THE  GEOMETRICS# 
PH3  THE  PARTICLES#  PH4  CALLS  THE 
6  POSSIBLE  FITS  THAT  CALCULATE  THE 
DENSITY#  VELOCITIES  AND  INTERNAL  ENERGY 
OF  THE  PARTICLES. 

20  CALL  PHI 

OUTPUT  CALCULATES  THE  VELOCITY  (BOTH 
RADIAL  AND  AXIAL)  AND  SPECIFIC  INTERNAL 
ENERGY  OF  EACH  CELL  FROM  THE 
TOTAL  MOMENTA  AND  INTERNAL 
ENERGY  AND  MASS  OF  EACH  CELL. 

OUTPUT  ALSO  PREPARES  A  DUMP  TAPE 
WHICH  IS  USED  THEN  TO  START  TOIL 
30  CALL  OUTPUT 
CALL  EXIT 
END 

SUBROUTINE  INPUI 


*******  A  2  MATERIAL  CLAM  FOR  THE  TOIL  CODE  ************** 


MZ=150 

CLEAR  Z  BLOCK. 

DO  30  I=1»MZ 
30  Z(I)=Q.G 

READ  IN  HEADING  CARD 
READ  (5»8012)IWS 
IWS=1 

WRITE  (6»8012) (IWS) 

WRITE  (6»8100) 

READ  IN  PROBLEM  CONSTANTS 
PROB=PROBL£M  NO.  AlMAX=IMAX# 

AJMAX=UMAX»  Q000FL  IS  NOT  USED-SET 
TO  ZERO#  SHELL  SET=2.»S8*S9  ARE 
ZERO#  SET  N7  TO=TAPE  NO. 

READ  ( 5 » 80  04 ) PROD » A IMAX  #  AUMAX » QO  0  OFL  #  SHELL » S8 » S9 1 N7 
IF(N7)40#40»50 
40  N7=9 


60 

INPU0640 

INPU06S0 

INPU0660 

INPU0670 

1NPUQ680 


MAIN0010 

MAIN0020 

MAIN0030 

MAIN0050 

MAIN0060 


MAIN0070 


MAIN0080 


MAIN0090 

MAIN0100 

MAIN0110 

INPU0010 

INPU0710 


INPU0730 

INPU0940 

INPU0960 

INPU0970 

INPU0980 

INPU0990 

INPU1000 

INPU1010 

INPU1020 

INPU1030 

INPU1040 


INPUI050 
INPUI 060 


o  o 


2000 


2001 

2002 

2003 

2004 
2006 
2008 

C 

2010 


2012 

2014 


2030 


maxI1 number  of  zones  in  r  direction. 

MI=10Q 

MAX.  NUMBER  OF  ZONES  IN  Z  DIRECTION. 

MJ=100 

MAX.  NUMBER  OF  PARTICLES/CELL. 

MNP=400 

SIZE  OF  TABLE  (TAB) 

JTM-500 

MAXIMUM  I*J 
MAX.  NUMBER  OF  CELLS. 

MIvJ=4999 

CALCULATE  ADDI flONAL  INDICES  FOR  TCLAM 
AND  TOIL. 

IMAX=AIMAX 

jmax=aumax 

IMAXA=IMAX+1 

IXMAX=IMAXA+1 

JMAXA=UMAX+1 

KMAX=(IMAX*JMAX)+l 

KMAXA=KMAX+1 

WRITE  (6#8048) (PR  'B# IMAX# UMAX) 

CHECK  INPUT  NOS.  CONCERNED  WITH  GRID  SIZE. 

.  IF(IMAX-MI)102»10  i»9901 
1  IF ( JMAX"MJ)  104#  10':  #9902 
^  IF  (KMAX-MIJ-1)  10(  .*  106 r 9903 
>  N0D=1 
NPC=1 
NRC-0 

READ  IN  DY  AND  DX 

1=0 

J=0 

X(I)=0.0 

3  READ  °(5»8102)  IVYS \»  IWSB#Nl»N2#N3#Nt*»  (TEMP(K)  »K=1»4) 
L=1 

COUNT  NO.  OF  DIFFERENT  DX  OR  DY . 

IF (N4) 2003 #2001 #2003 

1  IF (N3) 20 04 #2002 #2004 

2  IF (N2) 20 06? 20 08 #20 06 

3  L=L+1 

4  L=L+1 
6  L=L+1 

8  IF (IWSB) 2010 #2010 #2030 

PROCESS  THE  DX  AND  DY  VALUES. 

0  DO  2014  H=1»L 
NK=I2(N+50) 

DO  2012  K=1»NK 
1=1+1 

DX( I)=TEMP(N) 

X(I)=X(I-1)+DX(I) 

2  CONTINUE 
4  CONTINUE 
60  TO  2050 

CALC  THE  Y  AND  DY  VALUES 
10  DO  2034  N=1»L 
NK=IZ(N+5Q) 


iNruioso 


INPUHOO 

INPU1110 

INPU1120 

INPU1130 

INPU1140 


INPU1160 

INPUH70 

iNPUiiao 

INPU1190 

INPU1200 

INPU1210 

INPU1220 

INPU1230 

INPU1240 

INPU1250 

INPU1260 

INPU1270 

INPU1280 

INPU1290 

INPU1300 

INPU1310 

INPU1320 

INPU1330 

INPU1340 

INPU1350 

IMPU1360 

INPU1370 

INPU1380 

INPU1390 

INPU1400 

INPU1410 

INPU1420 

INPU1430 

IMPU1440 

INPU1450 

INPU1460 

INPU1470 

INPU1480 

INPU1490 

INPU1500 

INPU1510 

INPU1520 

tnph:.53o 

IMPU1540 

INPU1550 
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v 


i  2032 
2034 
2050 
C 

2052 
C 

2053 

2054 


C 


C 

•c 


looa 

c 


1010 


c 

c 

c 


1014 

c 

c 


€ 

r 

9901 


DO  2032  K=1,NK 

INPU1560 

J=J+1 

INPU1570 

DY(J)=T£MP(N) 

INPU1580 

Y(J)=Y(J-1)+DY(J) 

INPU1590 

CONTINUE 

INPU1600 

CONTINUE 

INPU1610 

XF(IWSA)2Q52, 2000, 2052 

INPU1620 

IF(  =  )  READ  MORE  DX  OR  QY  DATA  CARDS. 

IF (J- JMAX) 9905 , 2053 , 9905 

INPU1630 

CHECK  INPUT  NUMBERS. 

IF (I-1MAX)9906, 2054,9906 

INPU1640 

CONTINUE 

INPU1650 

READ  C  5 , 8004 ) WS , WSA , WSB , SWITCH 

INPU1660 

N4=MAX.  NUMBER  OF  PARTICLES-1  PER  RECORD. 

N4=WSB 

INPU1710 

NPRI=N4 

NPRR=N4  s 

INPU1720 

INPU1730 

WRITE  (6,8064) IMAX, (X( I ) , 1=0 , IMAX) 

INPU1740 

WRITE  (6,8065) JMAX, (Y(J) ,J=0,JMAX) 

INPU1750 

WS=3. 1415927 

INPU1760 

WSA=0.0 

INPU1770 

CALCULATE  THE  AREA~S(TAU}=PI(R(I)**2~ 

R(I-1)**2). 

DO  1008  1=1, IMAX 

INPU1780 

WSB=WSA 

INPU1790 

WSA=X ( I ) **2 

INPU1800 

TAU(I)=WS*(WSA-WSB) 

INPU1810 

WRITE  OUT  X,Y,DXiDY,  AND  TAU  VALUES. 

WRITE  (6,8066) IMAX, (DX( I) , 1=1, IMAX) 

INPU1820 

WRITE  (6,8067) JMAX» (OY ( I ), 1=1, UMAX) 

INPU1830 

WRITE  (6,8092)  (IMAX,  (TAU(I)  ,1=1, IMAX)  )• 

INPUI840 

XMAX=X(IMAX) 

INPU1850 

TXMAX=XMAX*2.0 

INPU1860 

YMAX=Y (JMAX) 

INPU1870 

TYMAX=YMAX*2.G 

INPU1880 

PIDY  IS  REALLY  PI (3.1415927) . 

PIDY=W5 

INPU1890 

SET  VELOCITIES,  INTERNAL  ENERGIES  AND  MASSES 

TO  0. 

DO  1014  I=1»KMAXA 

INPU1910 

U(I)=0.0 

INPU1920 

V(I)=0.0 

*  INPU1930 

AIX( I)=0.0 

INPU1940 

AMX(X)=0.0 

INPU1950 

AID(I)=0* 

AMD( I )=0. 

CONTINUE  • 

INPU1960 

SET  TOTAL  ENERGY  TO  ZERO. 

ETH=0.0 

INPU1970 

INITIALIZE  MIN.  MASS  PARTICLE  TO  A  LARGE  NO. 

AMDM=i.E+28 

INPU1980 

AMXM=AMDM 

INPU1990 

GO  TO  2016 

INPU2000 

ERROR 

INPU2010 

YO  -  H.A'  C  IMAX  GREATER  THAN  100 

NK=101 

INPU2020 

GO  TO  9999 

INPU2030 

o  o  o  o  o 


£ese=fiB~s-*. 


_ : _ _ ^  aacsaa^ 


63 


C  YOU  HAVE  JMAX  GREATER  THAN  100 

,  9902  NK=102  INPU2040 

60  TO  9999  INPU2050 

C  YOU  HAVE  TRIED  TO  GENERATE  MORE  THAN 

C  4999  CELLS. 

'  9903  NK=lQ4  -  INPU2060 

GO  TO  9999  INPU2070 

C  JMAX  OOF.S  NOT  EQUAL  THE  SUM  OF  THE  INPUT  J  INPU2000 

9905  NK=2052  INPU2090 

GO  TO  9999  INPU2100 

C  IMAX  DOES  NOT  EQUAL  THE  SUM  OF  THE  INPUT  I  INPU2110 

•9906  NK=2053  INPU2120 

9999  WRITE  (6f8888)NKf If JfKfLfMfN  INPU2130 

PRINT  8888fNKf  XfJ/KfLfMfN  INPU2140 

CALL  DUMP  INPU2150 

2016  RETURN  INPU2160 

C  FORMATS  INPU2170 


8004  FORMAT (7£10o5f 12) 

80120FORMAT  (Ilf71HTHI5  IS  THE  CLAM  PROGRAM  AND  THERE  IS  AN  ERROR, 


) 


8048 

8064 

8065 

8066 
8067 
8092 
8100 
8102 
8888 


FORMAT (1H 
FORMAT (1H 
FORMAT (1H 
FORMAT (1H 
FORMAT (1H 
FORMAT (1H 
FORMAT (1H 


/9H  PROQ  N0.F9.3»12X»2HI=I2f26X>2HJ=I2) 
/10H  XU)  I=0»I2/(5F16.6>> 

Y ( J)  J=0»I2/(5F16.6)) 

DX(I)  I=1#I2/(5F16.6)) 

DY(J)  J=1#I2/<5F16,6)> 

AREA(I)  I=lrl2/(5F16.6)) 

(TOIL  INPUT)) 


/10H 
/11H 
/11H 
/13H 
/14H 

FORMAT ( 21 1 » 4I2f 4E10.4) 
FORMAT (1H+/26H1  INPUT  ERROR 
END 

SUBROUTINE  PHI 


IN  STATEMENTI5rl2X»12H  INDICES 


INPU2180 

INPU2190 

INPU2200 

INPU2210 

INPU2220 

INPU2230 

INPU2240 

INPU2250 

INPU2260 


INPU2280 
ARE6I7) INPU2290 
INPU2300 
PHI  0010 
INPU0710 


*******  A  2  MATERIAL  CLAM  FOR  THE  TOIL  CODE  ************** 


READ  IN  GEOMETRY  ETC. 

NPP=7 
NPR=NPP-1 
TPIDY=PIDY*2.0 
ND=0 
NX=0 
NT=1 
NYY=1 

C  FIRST  CARD  OF  EACH  PACKAGE. 

READ  (5»8008)lX»LXfMXrTEMP(l)#TEMP(2)fTEMP(3) 
c  initialize-  the  NUMBER  OF  PACKAGES  TO  0. 

NPKG=0 

2015  IF CIX-1) 990 If 20 18 >20 18 

2016  IX=I 
LX=L 
MX=M 

C  IF  THERE  ARE  NO  MORE  PACKAGES  GO  COMPUTE  TOTAL  VALUES 

C  THE  LAST  CARD  HAS  A  2  PUNCH  IN  COL  1. 

2017  IFUX~2)2018f 7000  r  9902 

2018  J=0 
NPKG=NPKG+i 


PHI  0960 
PHI  0980 
PHI  0990 
PHI  1000 
PHI  1010 
PHI  1020 
PHI  1030 
PHI  1040 

PHI  1050 

PHI  1060 
PHI  1070 
PHI  1080 
PHI  1090 
PHI  1100 
PHI  H10 

PHI  1120 
PHI  1130 

phi  nmo 


y  rt 


l 
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c 

SET  PACKAGE  MASS  AND  ENERGY  TO  0. 

■ 

PE=0»0 

PHI 

1150 

PM=0.0 

PHI 

1160 

c 

ORIGIN  FOR  THE  RADIUS  VECTORS  TO  BE  USED 

c 

FOR  THE  FIT  ROUTInESU  THRU  6). 

YC=TEMP(1) 

PHI 

1170 

XC=TEMP(2> 

PHI 

1180 

c 

S8  CONTAINS  THE  FIT  NUMBER  FOR  THE 

c 

PACKAGE  IN  QUESTION. 

S8=TEMP(3) 

PHI 

1190 

WRITE  (6#8100) <NPKG#MX> 

PHI 

1200 

c 

NOW  READ  IN  THE  GEOMETRY  AND  DENSITY » 

c 

ENERGY  AND  VELOCITY  CARDS. 

o 

CM 

o 

CO 

READ  (5*8008) I»L>M» (TEMP(N) #N=1»6) 

PHI 

1210 

IWS=1 

PHI 

1220 

IF (I -5) 2021 #2040 *2022 

PHI 

1230 

C 

IF=»  THIS  IS  A  RHO*  VELOCITY  OR  ENERGY  CARD. 

C 

IF  LESS#  YOU  HAVE  READ  ALL  CARDS  FOR  THIS 

C 

PACKAGE  IN#  PLUS  THE  FIRST  CARD  FROM  THE 

C 

NEXT  PACKAGE. 

2021 

IF ( 1-3 ) 2060 » 9903  *  2026 

PHI 

1240. 

C 

IF  GREATER#  EITHER  A  TRIANGLE  OR  PERTURBED  ELLIPSE. 

'•  2022 

IF (L) 9904 #2030 #2024 

PHI 

1250 

C 

A  PERTURBED  ELLIPSE, 

2024 

IWS=7 

PHI 

1260 

T 

GO  TO  2030 

PHI 

1270 

2026 

IWS=3 

PHI 

1280 

2027 

IF (L) 9905 #2030 #2028 

PHI 

1290 

2028 

IWS=5 

PHI 

1300 

C 

A  TRIANGLE. 

2030 

IF (M) 9906 #2034# 2032 

PHI 

1310 

C 

IF=»  DELETE  THIS  GEOMETRY. 

2032 

IWS=IWS+1 

PHI 

1320 

2034 

J=U+1 

PHI 

1330 

C 

TAB  STORAGE  CONTAINS  THE  COORDINATES  OF 

C  ‘ 

GEOMETRY. 

ITABIJ)=IWS 

PHI 

1340 

DO  2036  N=1*NPR 

PHI 

1350 

J=J+.l 

PHI 

1360 

2036 

TAB  (»J) -TEMP  IN) 

PHI 

137Q 

GO  TO  2020 

PHI 

1380 

C 

ONE  ONLY  RHO » I » U  OR  V  ALLOWED  PER  PACKAGE 

’  PHI 

1390 

c 

IF=»  THIS  IS  A  DENSITY  CARD. 

l 

2040 

IF (L-l) 9907 #2046 *2042 

PHI 

1400  ; 

C 

IF  GREATER*  EITHER  A  VELOCITY  OR  ENERGY  CARD. 

» 

2042 

IF (L~3) 2052*2058*9908 

PHI 

1410 

C 

IF=»  THIS  IS  A  VELOCITY  CARD#  IF  LESS*  THIS  IS  A 

C 

ENERGY  CARD, 

C 

DENSITY 

PHI 

1420 

2046 

DO  2048  N=I*6 

PHI 

1430 

*  2048 

TABR(N)=TEMP(N) 

PHI 

1440 

GO  TO  2020 

PHI 

1450 

C 

ENERGY 

PHI 

1460 

'  2052 

DO  2054  N=l*6 

PHI 

1470 

2054 

TABI(N)=TEMP(N) 

PHI 

1480 

GO  TO  2020 

PHI 

1490 

C 

VELOCITY  (U  AND  V) 

PHI 

1500 

I 


<$5 


2058  00  2059  Nnl#6 
.2059  TAGUV(N)=TEMP(N> 

GO  TO  2020 

C  OUTPUT  DENSITY #  ENERGY#  AND  VELOCITY  PARAMETERS 

C  ALL  CARDS  FOR  THIS  PACKAGE  HAVE 

C  BEEN  READ  IN. 

2060  IF (J-JTM) 2070 #2070  #9915 

2070  WRITE  (6? 8036) (TABR( II) # 11=1# 6) 

WRITE  (6#8038) (TAUl (II) » II=1#6> 

WRITE  (6# 8040) (TALUV(II) # II=1#6) 

C  COMPUTE  BOUNDARIES  OF  GEOMETRIES  FOR  EFFICIENCY  IN 

C  GENERATING  OR  DELETING  PARTICLES 

3000  CALL  PH2 

C  COMPUTE  KO)  #I(N)  #J(0)  AND  J(N)#FROM  PREVIOUSLY 

C  COMPUTED  VALUES r FOR  UPPER  AND  LOWER  LIMITS  IN 

C  THE  CELL  MESH  SCAN 

C  IXN=MINIMUM  (I)  OF  GEOMETRY  OF  PACKAGE 

C  IYN=MINIMUM  (J)  OF  GEOMETRY  OF  PACKAGE 

C  IXX=MAXIMUM  (I)  0,  GEOMETRY  OF  PACKAGE 

C  IYX-MAXIMUM  (J)  OF  GEOMETRY  OF  PACKAGE 

3001  IXN=1 
IXX=1 

IWS=IMAX-1 

3800  IF (IWS) 9929# 3820 #.“801 

3801  DO  3808  N=1pIWS 

IF (X(N)“GXN) 3802# 1 304# 3804 

3802  IXN=IXN+1 

3804  IF (X(N)“GXX) 3806 r.. 306 #3808 
3806  IXX=IXX+1 

3803  CONTINUE  . 

IF  (IXN)  3812  #3812  #..814  N 

3812  IXN=1 

3814  IF (IMAX- I XX) 3816 #1318 #3818 

3816  IXX=IMAX 

3818  IF ( IXN-IXX)  3820 » 3A20 » 9930 

3820  IYN=1 
IYX=1 

IWS=JMAX-1 

3821  IF ( I WS ) 9929 » 3834#  3822 

3822  DO  3813  N=1#IWS 

3823  IF ( Y (N) -GYN ) 3819 » 3817 » 3817 

3819  IYN=IYN+1 

3817  IF(Y(N)~GYX) 3815#  ’815# 3813 

3815  IYX=IYX+1 

3813  CONTINUE 

IF ( I YN ) 3824 1 3824 » 3826 

3824  IYN=1 

3826  IF ( UMAX- JYX ) 3828 #  3830 » 3830 
3828  IYX=JMAX 

3830  IF(IYN-IYX)3834»3634,9931 
*'3834  WRITE  (6# 8044)  I.XN#  IYN#  IXX#  IYX 

C  SCAN  CELL  MESH  TO  DETERMINE  IF  PARTICLES  ARE  TO  BE 

C  GENERATED  OR  DELETED 

C  GENERATE  PARTICLES 

4000  CALL  PH3 


C 

6011  LA=NY-NT 


PHI  1510 
PHI  1520 
PHI  1530 
PHI  1540 


PHI  1550 
PHI  1560 
PHI  1570 
PHI  1580 
PHI  1590 
PHI  1600 
PHI  1610 
PHI  1620 
PHI  1630 
PHI  1640 


PHI  1650 
PHI  1660 
PHI  1670 
PHI  1680 
PHI  1690 
PHI  1700 
PHI  1710 
PHI  1720 
PHI  1730 
PHI  1740 
PHI  1750 
PHI  1760 
PHI  1770 
PHI  1780 
PHI  1790 
PHI  1800 
PHI  1810 
PHI  1820 
PHI  1830 
PHI  1840 
PHI  1850 
PHI  I860 
PHI  1870 
PHI  1880 
PHI  1890 
PHI  1900 
PHI  1910 
PHI  1920 
PHI  1930 
PHI  1940 
PHI  1950 
PHI  1960 
PHI  1970 
PHI  1980 
PHI  1990 
PHI  2000 
PHI  2010 


REARRANGE  X#Y  AND  M  FOR  PARTICLES  IF  NECESSARY 


o  o  o  n  o 
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IF (LX ) 9947  ? 6020 ? 6022 
•  6020  ND~ND+LA 

GO  TO  6024 
6022  NX=NX+LA 
.  6024  NT=NY 

eth=eth+pe 

WS=PL0T<1) 

6026  IF (LX) 9933 #6023 >6030 
6028  V/S=PL0T(2) 

6030  WRITE  ( 6  > 8501 ) LA ? WS > PE ? PM 
C  GO  READ  IN  NEXT  PACKAGE 

6050  GO  TO  2016 
7000  NMAX=NT 

NMAX=MAX.  NUMBER  OF  PARTICLES+1. 

YOU  HAVE  PROCESSED  ALL  PACKAGES?  ALL 
PARTICLES?  NOW  GO  TO  THE  OUTPUT. 

IF (AM (2) ) 4051? 4050? 4051 

4050  N3=NRC 
GO  TO  4060 

4051  NRC=NRC+1 
N3-NRC 

N3=NO.  OF  PARTICLE  RECORDS  OF 
N4  WORDS. 

4060  N6=NMAX-(N4-1)*(N3-1) 

N0PR=N3 
GO  TO  10000 
C  ERROR 

9901  NK=2015 

GO  TO  9999 

9902  NK=2017 

GO  TO  9999 

9903  NK=202l 

GO  TO  9999 

9904  NK-2022 

GO  TO  9999 

9905  NK-2027 

GO  TO  9999 

9906  NK=2030 

GO  TO  9999 

9907  NK-2040 

GO  TO  9999 

9908  NK=2042 

GO  TO  9999 
9915  NK-2060 

GO  TO  9999 

9929  NK-3800 

GO  TO  9999 

9930  NK=3818 

GO  TO  9999 

9931  NK-3830 

GO  TO  9999 
9933  NK=6026 

GO  TO  9999 
"  9947  NK~6011 

9999  WRITE  (6?8888)NK 
PRINT  8888 ?NK 
CALL  DUMP 


PHI  2020 
PHI  2030 
PHI  2040 
PHI  2050 
PHI  2060 
PHI  2070 

PHI  2100 

PHI  2130 
PHI  2140 
PHI  2150 
PHI  2160 


PHI  2170 
PHI  2100 
PHI  2190 
PHI  2200 
PHI  2210 


PHI  2240 
PHI  2250 
PHI  2270 
PHI  2280 
PHI  2290 
PHI  2300 
PHI  2310 
PHI  2320 
PHI  2330 
PHI  2340 
PHI  2350 
PHI  2360 
PHI  2370 
PHI  2380 
PHI  2390 
PHI  2400 
PHI  2410 
PHI  2420 
PHI  2430 
PHI  2440 
PHI  2450 
PHI  2460 
PHI  2470 
PHI  2480 
PHI  2490 
PHI  2500 
PHI  2510 
PHI  2520 
PHI  2530 
PHI  2540 
PHI  2550 
PHI  2560 
PHI  2570 
PHI  2580 


o  n  o  o  o  o  o  o  r>  o  o  o  o  o  oooooooor> 


67 


10000  RETURN  PHI  2590 

C  FORMATS  PHI  2600 

0008  FORMAT  (211 , 15? El3. 5* 5E1G .5)  PHI  26lo 

8036  FORMAT (1H07X»8HDENSITY  9X.1P6E1&.6)  PHI  2620 

8038  FORMAT (1H07X.8HENERGY  9X.1P6E16.6)  PHI  2630 

8040  FORMAT (lH07X»8HVELOCXTY9XriP6Ei6,&/iH0/)  .  PHI  2640 

8044  FORMAT (1H  /6H  I  (1)  =12* +X,  5HJ ( 1 )  =12# 4X» SHI  (N)  =I2,4X»  5HJ(N)  =12)  PHI  2650 
81000FORMAT  (1H0///12HOPACKAGE  wO.  13,  120 , 15H  PARTICLES/CELL//33X*  2HA114xPH1  2660 
1 , 2HA214X ,  2HA314X , 2HA414X , 2HA514X , 2HA6 )  PHI  2670 

85010FORMAT(1HO/I28#2H  (A3.11H)  PARTICLES22X. 4HP£  =1PE12.6, 1&X.4HPM  =ElPHl  2660 
12.6)  PHI  2690 

8888  FORMAT (23H1PH1  ERROR  IN  STATEMENTS)  PHI  2700 

END  PHI  2710 

SUBROUTINE  PH2  PH2  0010 


*******  A  2  MATERIAL  CLAM  FOR  THE  TOIL  CODE  ************** 


ALCULATE  THE  PACKAGE  GEOMETRIES 


GENERATING  OR  DELETING  PARTICLES 
J=VALUE  OF  LAST  COORDINATE  READ  IN* 

JT=J 

INITIALIZE  OUTER  BOUNDARIES. 

GXN=XMAX 
GYN=YMAX 
GXX~0  0  0 
GYX-0.0 

NPP=7(SET  IN  PHD. 

DO  3700  J=1»JT#NPP 

IWS  STORED  TN  ITA3  ARRAY  IN  PHl. 

IF  IWS=2(A  TRIANGLE) ,IF=4( A  RECTANGLE), 

IF=6,A  ELLIPSE  OR  CIRCLE.  IF  IWS=8,A 
PERTURBED  ELLIPSE.  IF  IWS  IS  LESS  THAN 
THESE  VALUES.  THE  DEFINITION  STILL  HOLDS.  BUT 
NOW  DELETE  THIS  GEOMETRY. 

KK=(ITAB(J)-l)/2 

3007  IF (KK) 9919, 3010 ,3008 

3008  IF(KK-2)3100. 3200.3009 

3009  IF(KK-4)3400, 9920. 9920 

TRIANGLE 

VERTICES  CAN  BE  INPUTED  IN  ANY  ORDER, 

X  COORDINATE  FIRST. 

SEARCH  FOR  THE  LARGEST  X(WSE)  AND 
SMALLEST  X(WSD). 

FIND  MAXIMUM(WSE)  AND  MINIMUM(WSD)  X  COORDINATE 

3010  IF(TAB(J+l)-TAB(J+3)  )30U, 3012*3013 

3011  WSE=TAB(J+3) 

ViSD=TAB(U+l) 

GO  TO  3014 

3012  TAB (0+l)=TAB(J+l)*l. 0000001+1. OE-8 

3013  WSE=TAB(U+i) 

WSD=TAB(U+3) 

3014  IF(TAB(J+5)“WSD) 3020, 3019, 3016 

3016  IF ( TAB (U*5 ) “WSE ) 3024 ,3017, 3018 

3017  TAB (U+5)=TAB< J+5)*l, 0000001+1. QE~9 


PH2  0020 
PH2  0740 
PH2  0950 
PH2  0960 
PH2  0970 

PH2  0980 

PH2  0990 
PH2  1000 
PH2  1010 
PH2  1020 

PH2  1030 


PH2  1040 
PH2  1050 
PH2  1060 
PH2  1070 
PH2  1080 


PH2  1090 
PH2  1100 
PH2  1110 
PH2  1120 
PH2  1130 
PH2  1140 
PH2  1150 
PH2  1160 
PH 2  1170 
PH2  1180 
PH2  119C 


o  o 


68 


3018  V/SE=TAB(J+5» 

80  TO  3024 

3019  TAB ( J+5)=TAB ( J+5) *0 .9999999-1 . 0E"8 

3020  v)SD=TAB(J+5) 

.C  ARRANGE  VERTICES  IN  ASCENDING  ORDER 

3024  IF  (TAB (J+2) "TAB (J+4) ) 3036, 3034 , 3038 
3034  TAB (J+2)=TAB( J+2) *1. 0000001+1. OE-8 
GO  TO  3038 
3036  WSA=TABIJ+1) 

V/SB=TAB(J+2) 

TAB( J+1)~TA8( J+3) 

TAB ( J+2) =TAB ( J+4) 

TAB(J+3)=WSA 
TAB ( J+4) =WSB 

3038  IF(TAB ( J+4) "TAB ( J +6) ) 3042, 3040  >  3044 
3040  TAB(J+6)=TAB(J+6)  .>0 .9999999-1 . 0E-8 
GO  TO  3044 
3042  WSA=TABU+3) 

WSB=TAB(J+4) 

TAB(J+3)=TAB(J+5> 

TAB ( J+4) =TAB (J+6) 

TAB(J+5)=WSA 
TAB(J+6)=WSB 
GO  TO  3024 

WSF=MINIMUM  VALUF.  OF  Y 
WSG=MAXIMUM  VALUE  OF  Y 
3044  WSF=TAB(J+6) 

WSG=TAB(J+2) 

C  COMPUTE  SLOPES 

SLA= ( TAB (J+4) -TA  (J+2) ) / ( TAB (J+3) -TAB (J+l ) > 
SLB=(TAB(J+6)~TA:  (J+2) ) / (TAB ( J+5) -TAB ( J+l ) ) 

3053  IF (SLA-SLB) 3054,^921,3058 

3054  IF (SLA) 3056,9922,3064 
3056  IF (SLB) 3064,9923, 3062 
3058  IF ( SLA ) 3062 » 9924 » 3056 
3062  WSA=TAB(J+3) 

WSB=T.,3(J+4) 

WSC=SLA 

TAB ( J+3)=TAB ( J+5) 

TAB ( J+4)=TAB ( J+6) 
ci  A=S1  B 
",  AB(  J+5)=l/SA 
TAB(J+6)=WSB 
SLB=V/SC 

3064  IF (TAB( J+3) -TAB (J+5) >3066,9925,3068 
3066  ITAB (J) -ITAB (J) +2 
IWS=ITAB(J)-3 
GO  TO  3069 
30o8  Iv/S”ITAB(J)“1 
3069  KE=J+1 
:  KF=KL+5 

WS=PL0T(3) 

IF(IWS)3072, 3070, 3072 
•  3070  WS=PL0T(4) 

3G72  WRITE  (6, 8016)  V/S,  (  TAB  (U)  , N=KE , KF) 
kVS-TAb  ( J+2 )  -SLB*  TAB  ( J+ 1 ) 

TAB ( J+l ) =TAO (J+2 ) -SLA  * TAB ( J+l ) 


PH2  1200 
PH2  1210 
PH2  1220 
PH2  1230 
PH2  1240 
PH 2  1250 
PH2  1260 
PH2  1270 
PH2  1200 
PH2  1290 
PH2  1300 
PH2  1310 
PH2  1320 
PH2  1330 
PH2  1340 
PH2  1350 
PH2  1360 
PH2  1370 
PH2  1380 
PH2  1390 
PH2  1400 
PH2  1410 
PH2  1420 
PH2  1430 


Prl2  1440 
PH2  1450 
PH2  1460 
PH2  1470 
PH2  1480 
PH2  1490 
PH2  1500 
PH2  1510 
PH2  1520 
PH2  1530 
PH2  1540 
PH2  1550 
PH2  1560 
PH2  1570 
PH2  1580 
PH2  1590 
PH2  1600 
PH2  1610 
PH2  1620 
PH2  1630 
PH2  1640 
PH2  1650 
PH2  1660 
PH2  1670 
PH2  1680 

PH2  1710 

PH2  1740 
PH2  1750 
PH2  1760 
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TAB ( J+6) = (TAB ( J+6)  -TAB ( J+4) ) / (TAB ( J+5) -TAB ( J+3) ) 

TAB(J+5)=TAB(J+4/~TAB(J+6)*TAB(J+3) 

rAB(J+2)=SLA 

TAB(J+3)=WS 

TAB(J+4)=SLB 

60  TO  3600 

C  RECTANGLE 

3100  ITAB(J)=ITA8(J)+2 
IWS=ITAB(J)-5 
WS=PL0T(3) 

IF  (IWS)  31.10 » 3105,  "51 10 
3105  WS=PL0T(4) 

3110  WRITE  (6»8020)WS> TAB(J+1) #TAB(J+2) »TAB(J+3) >TAB(J+4) 
WSD=TAB(J+1) 

WSE=TAB(J+2) 

WSF=TAB(J+3) 

WSG=TAB(J+45 
GO  TO  3600 

C  ELLIPSE  OR  CIRCLE 

3200  IF ( ABS (TAB ( J+l ) -TAB ( J+2) ) “1 . 0£-8) 3300 1 3300 » 3202 

3202  IF ( TAB ( u+2) ) 9926 >  5300  # 3203 

C  ELLIPSE  WITH  NO  PERTURBATION 

3203  ITAB(J)=ITAB(J)+2 
lWS=ITAB(J)-7 
WS=PL0T(3) 

IF, I WS ) 3210 » 3205 » 3210 
3205  WS=PL0T(4) 

3210  WRITE  (6 p 8024) WS? TAB (J+l) » TAB (J+2) » TAB (J+3) » TAB (J+4) 
3215  WSD=TAB(J+3)-TAB(J+l) 

WSE=TAB ( J+3 ) +TAB ( J+l ) 

WSF=TAB ( J+4 )-TA6( J+2 ) 

WSG=1 AB ( J+4 ) +TAB ( J+2 ) 

TAB ( J+l ) =TAB ( J+l ) **2 
TAB(J+2)=TAB(J+2)**2 
GO  TO  3600 

C  CIRCLE 

3300  ITAB(J)=ITAB(J)+4 
IWS=ITAB(J)-9 
TAB ( J+2) =TAB { J+l) 

WS=PL0T(3) 

IF ( IWS) 3310  ?  3305 » 3310 
3305  v/S=PL0T(4) 

3310  WRITE  (6»8028)WS»TAB(J+1) »TAB(J+3) »TAB(J+4) 

GO  TO  3215 

C  ELLIPSE  WITH  PERTURBATION 

3400  ITAB (J) -ITAB (J) +4 

WS=1.0”(TAB(J+5)/TAB(J+l) )**2 
I WSA- ITAB ( J+7 ) 

OTAB ( J+7 )  =  ( TAB ( J+6 ) -TAB ( J  *4 ) -TAB ( J+2 ) *SQRT ( WS ) ) / 

1  ( (TAB (J+5) * (TAB (J+5) -TAG (J+l ) ) )**2) 

IWS=ITAB(J)-11 
KE=J+1 
KF=KE+6 
WSA=PLOT(3) 

IF ( I WS) 3410  c  340b r 3410 
340b  WSA=PL0T(4) 

3410  WRITE  (6»8032)WSA» (TAB(N) »N=KE»KF) 


PH2  1770 
PH2  1780 
PH2  1790 
PH2  1800 
PH2  1810 
PH2  1820 
PH2  1830 
PH2  1840 
PH2  1850 

PH2  1880 

PH2  1910 
PH2  1920 
PH2  1930 
PH2  1940 
PH2  1950 
PH2  I960 
PH2  1970 
PH2  1980 
PH2  1990 
PH2  2000 
PH2  2010 
PH2  202R 

PH2  2050 

PH2  2080 
PH2  2090 
PH2  2100 
PH2  2110 
PH2  2120 
PH2  2130 
PH2  2140 
PH2  2150 
PH2  2160 
PH2  2170 
PH2  2180 
PH2  2190 

PH2  2220 

PH2  2250 
PH2  2260 
PH2  2270 
PH2  2280 
PH2  2290 
PH2  2300 
PI-12  2310 
PH2  2320 
PH2  2330 
PH2  2340 
PH2  2350 

PH2  2380 


PH2  2410 


3. 

T 
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3415 

IF (WS) 9927 #9927 #3420 

PH2 

2420 

j  3420 

IF (TAB (U+3) ) 9928 i 3425 #9928 

PH2 

2430 

•->425 

TAB(J+3)=TAB(J+7) 

PH2 

2440 

ITAB(J+7)=IWSA 

PH2 

2450 

• 

WSA=TAB(J+2)+TAB(J+2)/4.0 

PH2 

2460 

WSD=0 . 0 

- 

PH2 

2470 

WSE=TAB l J+l) +TAB ( J41 ) /4. 0 

PH2 

2480 

WSF=TAB  v*J+4 )  -WSA 

PH2 

2490 

WSG=TAB(J+4)+WSA 

PH2 

2500 

C 

DETERMINE  BOUNDARIES  OF  GEOMETRIES 

PH2 

251o 

3600 

IF ( WSD-GXN) 3602 » 3004  #  3604 

PH2 

2520 

V 

MAXIMUM  (X) 

3602 

GXN=WSD 

PH2 

2530 

3604 

IF ( WSE-GXX) 3608 » 3008  #  3606 

PH2 

2540 

C 

MINIMUM  (X) 

3606 

GXX=WSE 

PH2 

2550 

3608 

IF ( WSF-GYN) 3610 #  3612,3612 

PH2 

2560 

C 

MAXIMUM  (Y) 

3610 

GYN=WSF 

PH2 

2570 

3612 

IF ( WSG-GYX) 3700  # 3700  #  3614 

PH2 

2580 

C 

MINIMUM  (Y) 

3614 

GYX=WSG 

PH2 

2590 

:  3700 

CONTINUE 

PH2 

2600 

J=JT 

PH2 

2610 

GO  TO  10000 

PH2 

2620 

C 

ERROR 

PH2 

2630 

9919 

NK--3007 

PH2 

2640 

GO  TO  9999 

PH2 

2650 

9920 

NK=3009 

PH2 

2660 

GO  TO  9999 

PH2 

2670 

9921 

NK=3053 

PH2 

2680 

GO  TO  9999 

PH2 

2690 

9922 

NK=3054 

PH2 

270Q 

GO  TO  9999 

PH2 

2710 

9923 

NK=3056 

PH2 

2720 

GO  TO  9999 

PH2 

2730 

9924 

NK=3Q58 

PH2 

2740 

GO  TO  9999 

PH2 

2750 

9925 

NK=3064 

PH2 

2760 

GO  TO  9999 

PH2 

2770 

9926 

NK=3202 

PH2 

2780 

GO  TO  9999 

PU2 

2790 

9927 

NK=3415 

PH2 

2800 

GO  TO  9999 

PH2 

2810 

9928 

NK=3420 

PH2 

2820 

9999 

WRITE  (6#8888)NK 

PH2 

2830 

PRINT  8888# NK 

PH2 

2840 

CALL  DUMP 

PH2 

2850 

10000 

RETURN 

PH2 

2860 

8016 

FORMAT (15H0TRIANGLE  -  A3,7H  - — 

-1P6E16.6) 

PH2 

2870 

•'  8020 

FORMAT (15H0RECTANGLE  -  A3»7H  - — 

-1P6E16,6) 

PH2 

2880 

8024 

FORMAT (15H0ELL IPSE  -  A3#7H  - — 

-1P6E16.6) 

PH2 

2890 

8028 

FORMAT C15H0CIRCLE  -  A3#7H  - — 

-1PE16.6#16X»4E16.6) 

PH2 

2900 

'8032 

FORMAT (15H0P  ELLIPSE  -  A3»7H  - 

-1P6E16,6) 

PH2 

2910 

8888 

FORMAT (23H1PH2  ERROR  IN  STATEMENTS) 

PH  2 

2920 

END 

PH2 

2930 

SUBROUTINE  PH3 

PH  3 

0010 

71 

INPU0710 

*******  A  2  MATERIAL  CLAM  FOR  THE  TOIL  CODE  ************** 


£ 


c 

•* 

INPU0030 

c 

GENERATE  (OR  DELETE)  THE  PARTICLES 

PH3 

0020 

c 

PH3 

0740 

c 

PH3 

0950 

c 

PH3 

0960 

c 

PH3 

0970 

c 

SCAN  CEl  L  MESH  TO  DETERMINE  IF  PARTICLES  ARE  TO  BE 

PH3 

0980 

c 

GENERATED  or  DELETED 

PH3 

0990 

c 

GENERATE  PARTICLES 

PH3 

1000 

c 

SAVE  CURRENT  VALU.S  OF  COUNTERS. 

4000 

IA-I 

PH3 

1010 

JA=J 

PH3 

1020 

IJ=K 

PH3 

1030 

JT=L 

PH3 

1040 

IF ( I X-l) 9932*4010  > 9932 

PH3 

1050 

o 

H 

o 

IF  ( MX-MNP )  40 12  f  40 '»  2 » 9935 

PH3 

1060 

c 

IF  GREATER t  YOU  'I..IED  TO  GENERATE  MORE  THAN 

•c 

400  PARTICLES  /  CELL. 

4012 

WS=MX 

PH3 

1070 

FMX=SGRT(WS) 

PH3 

1080 

* 

MXS=FMX+,5 

PH3 

1090 

4011 

IF ( MXS*MXS~MX ) 993' , , 40 13 » 9936 

PH3 

1100 

C 

IF(GREATER  OR  LEfA)  THE  NO,  OF  PARTICLES  /  CELL 

C 

THAT  YOU  REQUESTFO  WAS  NOT  N  SQ.  WHERE 

C 

N  IS  FROM  1  TO  20, 

4013 

MXA=1-MX 

PH3 

1110 

TFMX=.5/FMX 

PH3 

1120 

WPIDY=TPIDY/FMX 

PH3 

1130 

4015 

IF(MXA) 4018 » 4018 » ‘  937 

PH3 

1140 

C 

IF  GREATER »  YOU  H..VE  FAILED  TO  SPECIFY  THE 

C 

NO.  OF  PARTICLES  ;0  GENERATE. 

4018 

NY=NT 

PH3 

1150 

DO  5700  I=IXN#IXX 

PH3 

1160 

C 

COMPUTE  THE  COORDINATE  OF  THE  PARTICLE 

PH3 

1170 

C 

UNDER  CONSIDERATION 

PH3 

1180 

WS5=DX ( I ) /FMX 

PH3 

1190 

C 

THE  VOLUME  OF  THE  SUBDIVIDED  CELL  = 

C 

PI(2.*XL(N)DY/N*UY/N) . 

TABX ( 1 ) =X ( I ) -TFMX*DX ( I ) 

PH3 

1200 

4019 

IF ( MXA ) 4020  p  4024  ?  9938 

PH3 

1210 

4020 

DO  4022  K=2»MXS 

PH3 

1220 

C 

WE  STaRT  AT  THE  RIGHT  AND  TOP  OF  CELL(K). 

C 

SET  UP  ARRAY  FOR  X  COORDINATES  OF  THE 

C 

PARTICLES. 

4022 

TABX ( K ) =TABX ( K~1 ) -WS5 

PH3 

1230 

•c 

U  LOOP?  LIMITS  OF  Y  FOR  THIS  PACKAGE. 

4024 

DO  5700  J=IYNpIYX 

PH3 

1240 

TAM=v.PIDY*WS5*DY(J) 

PH3 

1250 

•c 

TAM=  2PI/N*DX/N*DY 

E=0.0 

PH3 

1260 

IIWS=0 

PH3 

1270 

IWS=0 

PH3 

1280 

I 


72 

18=0 

PH3 

1290 

X 

WS=DY { JJ/FMX 

PH3 

1300 

T ABY ( 1 ) =Y ( J ) -TFMX*DY ( J ) 

PH3 

1310 

C 

MXS=N 

DO  4026  K=2»MXS 

P)<3 

1320 

'  c 

SET  UP  ARRAY  FOR  Y  COORDINATES  OF  THE 

. 

c 

PARTICLES. 

- 

4026 

TABY(K)=TABY(K-1)-WS 

PH3 

1330 

C 

K  USED  FOR  THE  CELL  QUANTITIES. 

K=(J-i)*lMAX+I+l 

PH3 

1340 

4028 

IBB=IB/MXS 

PH3 

1350 

IB=IB+1 

PH3 

1360 

IBA=M0D(IB»MXS) 

PH3 

1370 

C 

TX=X  COORDINATE  of  PARTICLE  IN  QUESTION. 

TX=TABX(IBA+JL) 

PH3 

1380  j 

C 

TY=Y  COORDINATE  OF  PARTICLE  IN  QUESTION. 

TY=TABYUBB+1) 

PH3 

1 

1390  j 

C 

GENERATE  OR  DELETE  THE  PARTICLE 

PH3 

1400  J 

ID=0 

PH3 

1410  1 

IG=0 

L=1 

PH3 

1420  1 

l 

4202 

CONTINUE 

S 

a 

• 

KK=ITAB(L) 

PH3 

1440  ! 

IF ( KK-5 ) 4062 » 4073 # 4078 

PH3 

1450  ■ 

C 

TRIANGLE 

PH3 

1460  1 

-  4062 

WSX=(TY-TAB(L+1) )/TAB(L+2) 

PH3 

1470  ; 

IF ( WSX-TX ) 4064  #  4064 # 4200 

PH3 

1480  j 

4064 

WSX= ( TY-TAB ( L+3 ) ) /TAB ( L+4 ) 

PH3 

1490  t 

IF ( WSX-TX ) 4200  #  4066#  4066 

PH3 

1500 

4068 

WSY=T AB ( L+6 )  *TX+  f AB ( L+5 ) 

PH3 

1510 

IF  CKK-2) 4068  r  4068 , 4072 

PH3 

1520 

4068 

IF ( WSY-TY ) 4200 » 4  070 » 4070 

PH3 

1530  | 

4070 

GO  TO  (4074»4076/4074»4076) »KK 

PH3 

1540  ‘ 

4072 

IF i WSY-TY) 4070 » 4070 , 4200 

PH3 

1550 

4074 

ID=1 

PH3 

1560 

GO  TO  4200 

PH3 

1570 

4076 

IG=1 

PH3 

1580  1 

GO  TO  4200 

PH3 

1590 

4078 

KK=KK-4 

PH3 

1600 

4077 

IF ( KK-8) 4079 » 4094 #9939 

PH3 

1610 

4079 

GO  TO  (4080 #4080 #4090 #4090 #4092 #4092. *4094) #KK 

PH3 

1620 

C 

RECTANGLE 

'  PH3 

1630 

4080 

IF ( TAB (L+1)~TX) 4082 #4082 #4200 

PH3 

1640 

4082 

IF(TAB  CL+2) -TX) 4200  #4084#  4084 

PH3 

1650  i 

4084 

IF (TAB (L+3) -TY) 4086# 4086# 4200 

PH3 

1660 

4086 

IF (TAB (L+4) -TY ) 4200  #  4088  #  4088 

PH3 

1670 

4088 

GO  TO  (4074*4076) #KK 

PH3 

1680 

C 

ELLIPSE  WITH  NO  PERTURBATION 

PH3 

1690 

4090 

KK=KK-2 

PH3 

1700 

IF  ( (TX-TAB-(L+3 ) )  *^2/TAB  (L+l )  +  ( TY-TAB  (L+4) )  **2 

PH3 

1710 

ja 

1/TAB (L+2)-loQ) 4088 #4088* 4200 

PH3 

1720 

C 

CIRCLE 

PH3 

1730 

4092 

KK=KK-4 

PH3 

1740 

-* 

0 IF ( ( TX-TAB (L+3 ) ) **2+ ( TY-TAB ( L+4 ) ) **2-TAB ( L+l ) ) 

PH3 

1750  j 

1  4088f4088»4200 

PH3 

1760 

C 

ELLIPSE  WITH  PERTURBATION 

PH3 

1770  J 

4094 

KK=KK-6 

PH3 

1780  i 

I 
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c 

c 


4201 

*4310 

^4312 


C 

C 

C 

C 

C 


4200  L=L+NPP 

IF(L-JA) 4202, 4201,4201 

IF  10=1  DELETE 
IF (10)9940,4310,4800 

IF  10=0  AND  IG=0  DELETE 
IF(IG)9941, 4800, 4312 

GENERATE  PARTICLE 

NY=NY+1 

IF (I I WS) 23, 22, 23 

22  IIWS=1 

23  IWS=1 
NYY=NYY+1 
CALL  PH4 

RETURN  FROM  PH4  -JITH  THE  FOLLOWING  OATA, 

WSR=PARTICLE  DENSITY 

WSI=PARTICLE  SPECIFIC  INTERNAL  ENERGY 
WSU=RADIAL  VELOCITY  COMPONENT  OF  pARTT.CLE 
WSV=AXIAL  VELOCITY  COMPONENT  OF  PARTICLE 

4332  N=NYY 

IF  ( 1 1  WS )  4335  r  43i‘> ,  24 

24  IIWS=“1 

4333  IF ( AMX ( K ) +AMO ( K ) )  9951 , 4335 , 4334 

°4334  E= U  K ) **2+V< K >  **2 ) /( AMX  ( K )  +AMD  ( K ) ) )  *  •  5+Al X  ( K )  +AID  ( K ) 
THE  FOLLOWING  IS  FOR  PIC  TRANSPORT  ONLY 
SET  THE  PARTICLE  COORDINATES  INTO  THE 
PROPER  ARRAYS. 

4335  XL(N)=TX 
YL(N)=TY 
C  SET  I  AND 

IW1(N)=I 
IW2(N)=U 

C  CALCULATE  PARTICLE  MASS  AS 

C  =2PI/N*DX/N*DY*XL(N)*RHO. 

AM(N)=TAM*TX*WSR 

C  CHECK  FOR  TYPE  OF  MASS(X  OR  .  ) 

4341  IF(LX)9945, 4342, 4344 

4342  WS=AM(N)*WSI 
IF  (AM(N)**AMOM)  10,15,15 

16  AMDM=AM(N)  v 

NOTE,  AID  HERE  IS  INTERNAL  ENERGY, 

NOT  SPEIFIC  INTRNAL  ENERGY. 

15  AID(K)-AID(K)+V/S 
PM=PM+AM(N) 

AMD(K)=AMD(K)+AM(N) 

AM(N) =-AM(N) 

GO  TO  4346 
4344  WS=AM(N)*WSI 

IF(AMtN)-AMXM) 18,17,17 
18  AMXM=AM(N)  _ 

NOTE,  AIX  HERE  IS  INTERNAL  ENERGY, 

NOT  SPECIFIC  INTERNAL  ENERGY. 

17  AIX(K)=AIX(K)+WS 
PM=PM+AM(N> 


C 

C 

c 


J  OF  CELL  K (LOCATION  OF  PARTICLE) 


C 

C 


C 

C 


PH3  1790 
PH3  1800 


PH3  1820 
PH3  1830 
PH3  1840 
PH3  1850 
PH3  I860 
PH3  1870 
PH3  1880 
PH3  1890 
PH3  1900 
PH3  1910 
PH3  1950 


PH3  1960 
PH3  1970 
PH3  1980 


PH3  2010 
PH3  2020 

PH3  2030 
PH3  2040 


PH3  2050 

PH3  2060 
PH3  2070 
PH3  2080 
PH3  2090 


PH3  2110 

PH3  2120 
PH3  2130 
PH3  2140 
PH3  2150 
PH3  2160 


PM3  2170 
PH3  2180 


n  o  o  oo 


SUM  UP  MASS?  BOTH  COMPONENTS  OF  MOMENTA 
AND  TOTAL  INTERN *L  ENERGY  IN  CELL  K. 

AMX(K)=AKX(K)4  t  N) 

**  NOTE?  U  AND  V  ARE  NOT  VELOCITY  COMPONENTS 
HERE  IN  PH3?  BUT  ARE  THE  RESPECTIVE 
RADIAL  AND  AXIAL  MOMENTAS. 

4346  U(K)=U(K)+ABS(AM{N) )*WSU 
V ( K, ) =V ( K ) +ABS ( AM ( N ) ) *WSV 
IF ( NY-NPRR ) 4800  ? 14 ? 9945 
14  NRC=NRC+1 

nprr=nprr+npri-i 

5001  NYY=1 

3  DO  2  N=2»NPRI 

C  SET  PARTICLE  ARRAYS  TO  ZERO. 

XL(N)=0.0 
YL(N)=0.0 
AM(N)=0.0 
IW1(N)=0 
IW2(N)=0 
2  CONTINUE 

4000  IF (MX-IB) 9946? 4830? 4028 
CALCULATE  ENERGY  FOR  PKG 
4880  IF (IWS) 4900? 5700; 4900 
4900  IF(AMX(K)+AMDCK) i9951?5700?4910 

4910  PEE=(U(K)**2+V(K)**2)/(AMX(K)+AMD(K) )*.5+AlX(K)+AlD(K) 
4930  IF(E)4950?4950?'!940 
4940  PEE=P£E-E 
4950  PE=PE+PEE 
5700  CONTINUE 
I-IA  . 

J=JA 

K=IJ 

L=JT 

GO  TO  10000 

C  ERROR 

9932  NK=4000 

GO  TO  9999 

9935  NK=4010 

GO  TO  9999 

9936  NK=4011 

GO  TO  9999 

9937  NK=4Q15 

GO  TO  9999 

9938  NK=4019 

GO  TO  9999 

9939  NK=4077 

GO  TO  9999 

9940  NK=4201 

GO  TO  9999 

9941  NK=4310 

GO  TO  9999 

9945  NK=4341 

GO  fO  9999 

9946  NK-4800 

GO  TO  9999 
9951  NK=4905 

9999  WRITE  ( 6 ? 8888 ) NK ? I ? J ? K ? L » M » N 


PH3  2190 


PH3  2200 
PH3  2210 
PH3  2220 
PH3  2230 
PH3  2240  : 
PH3  2270  I 
PH3  2280 

PH3  2290 
PH3  2300 
PH3  2310 
PH3  2320 
PH3  2330 
PH3  2340 
PH3  2350  . 
PH3  2360 
PH3  2370 


PH3  2400 
PH3  2410 
PH3  2420 
PH3  2430 
PH3  2440 
PH3  2450 
PH3  2460 
PH3  2470 
PH3  2480 
PH3  2490  ( 
PH3  2500 
PH3  2510 
PH3  2520 
PH3  2530 
PH3  2540 
PH3  2550 
PH3  2560 
PH3  2570 
PH3  2580 
PH3  2590 
PH3  2600 
PH3  2610 
PH3  2620  , 
PH3  2630 
PH3  2640 
PH3  2650 
PH3  2660  1 
PH3  2670 
PH 3  2680 
PH3  2690 
PH3  2700  ‘ 
PH3  2710  f 


oooooooo 


75 


,  .  „  ,  MM  PH3  2720 

PRINT  8888»NK#I»0»K»L»MrH  PH3  2730 

CALL  DUMP  PH3  2740 

’Tell  FORMAT C 1H+/26H1  P  H  3  ERROR  IN  STATEMENTI5.12X.12H  INDICES  ARE6I7)PH3  |7|0 

END  PH4  0010 

SUBROUTINE  PH4  INPU0710 

PM4  0730 


**  NOTEf  XC  AND  YC  ARE  COORDINATES  FOR  RELOCATING 
THE  ORIGIN  FOT  THE 

RH0» INTERNAL  ENERGY t  AND  VELOCITY  FITS* 

THE  ACTUAL  COORDINATES  USED  IN  THE  FIT 
SUBROUTINES  IS  T'f X-TX-XC  *TTY=TY~YC • 

TTX=TX-XC 

TTY=TY-YC 

LL=S8 

GO  T0(lr2r3»4»5>6) »LL 

1  CALL  FIT1 
60  TO  7 

2  CALL  FIT2 
GO  TO  7 

3  CALL  FIT3 
GO  TO  7 

4  CALL  FIT4 
GO  TO  1 

5  CALL  FIT5 
GO  TO  7 

6  CALL  FIT6 

7  RETURN 
END 

SUBROUTINE  FIT1 


WS=SQRT (TTX**2+TTY**2) 

WSRSTABR ( 1 ) +T ABR 1 2 ) * l TTY-T  ABR ( 3 ) ) 

pi  iCprY 

WSI=TABI  ( 1 )  +TABI  ( 2)  *  (TTY-T ABH  3 )  > 

WS=TABUV U ) +TABUV ( 2 ) * ( TT Y-T ABUV ( 3 ) ) 

WSU=0.0 

WSV=WS 

RETURN 

END 

SUBROUTINE  FIT2 


WS=SQRT(TTX**2+TTY**2) 

WSR=(  (TTX-TABRU)  J/TABR12)  )**2+(  (TTY-TABRC3) )/ 
1TABR (4) ) **2  ■ 

CmPOP Y 

WSl=TABm)+TAQl(2)*TTX+TABH3)*TTX**a 


PH4  0940 


PH4  0950 

PH4  0960 

PH4  0970 

PH4  0980 

PH4  0990 

PH.4  10.  • 

PH4  10 Id 

PH4  1020 

PH4  1030 

PH4  1040 

PH4  1050 

PH4  1060 

PH4  1070 

PH4  1080 

PH4  1090 

PH4  1100 

PH4  1110 

FIT10010 

INPU0710 

FIT10730 

FIT10940 

FIT10950 

FIT10960 

FIT10970 

FIT10980 

FIT10990 

FIT11000 

FIT11010 

FIT11020 

FIT11030 

FIT11040 

FIT11050 

FIT20010 

INPU0710 

FIT20730 

FIT20940 

FIT20950 

FIT20960 

FIT20970 

F1T20980 

FIT20990 

FIT21000 


nooooooooo  o  o  o  o  r>  o 
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1+TABI  (4) *TTY+TABI (5)*TTY**2  . 
C  VELOCITIES 

wsv=nrAbuv  ( 1 )  +taeuv  <  2)  *tty 

WSU=TABUV  ( 3 )  +TA13UV  ( 4 )  *TTY 

RETURN 

END 

SUBROUTINE  FIT3 


THIS  FIT  FOR  SIN  KZ/KZ  ************ 
WS=SQRT(TTX**2+TTY**2) 

DENSITY 

WSR=TABR ( 1 ) +TABR ( 2 ) * ( TTY-TABR { 3 ) ) 

WSA=TTY/TABI<2) 

WSB=WSA*PIDY*2. 

WSC=SIN(WSB> 

WSI=WSC/WSA*TABI(1> 

WS=TABUV ( 1 ) +TABUV ( 2 ) * { TTY-TABUV ( 3 ) ) 

WSU=0. 

UICV— we 

WSI=WSI*TABI(3) 

TABI(3)  US  SCALE  FACTOR  FOR  YIELD  NORMALLY  SET  TO  1. 

RETURN 

END 

SUBROUTINE  FIT4 

RETURN 

END 

SUBROUTINE  FITS 

RETURN 

END 

SUBROUTINE  FIT6 

RETURN 

END 

SUBROUTINE  OUTPUT 


FIT21010 

FIT21020 

FIT21030 

FIT21040 

FIT21050 

FIT21060 

FIT30010 

INPU0710 

FIT30730 

FIT30940 

FIT30950 

FIT30960 


FIT40010 

FIT40020 

FIT40030 


FIT60010 

FIT60020 

FIT60030 

OUTPOOlo 


INPU07I0 


*******  a  2  MATERIAL  CLAM  FOR  THE  TOIL  CODE  ************** 


LAM  ******  OUTPUT  ****** 


PACKAGES  HAVE  BEEN  READ  IN  AND  PROCESSED 
COMPUTE  TOTAL  ENERGIES  AND  TOTAL  MASSES 

E=E7H 

WRITE  (6»8104* 

7001  N0=ND+1 

IF(E)60G0»6000*6001 

6000  AMDM=0.0 
AMXM=0.0 
GO  TO  7016 

6001  AMDM=AMDM/2 • 0 
AMXM=AMXM/2.0 

7013  IF (AMDM) 990 If 9901 >70 14 

7014  IF {AMXM)9902»9902»7016 


OUTP0020 

OUTP0030 

OUTP0750 

OUTP0970 

OUTP0900 

OUTP0990 

OUTR1000 

OUTP1010 

0UTP10.20 

OUTP1030 

OUTP1040 

OUTP10SO 

OUTP1060 

OUTP1070 

OUTPIOBO 

OUTP1090 

OUTPllOO 
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7016  KTHnO.O 
TMDZ=O.G 
TMXZ=0»0 

DO  7015  I=2,KMAX 

7017  IF (AMD (I)) 9904.7010.7004 
7010  WSI=0. 

IF ( AMX( I) ) 9904.7012.7006 

7004  TMDZ=AMD(I)+TMD/- 
WSI=A1D(I) 

C  CALCULATE  THE  SPECIFIC  INTERNAL  ENERGY 

C  FOR(.)  MATERIAL  IN  CELL  K. 

AID ( I ) =AID ( I ) /AMD ( I ) 

7005  IF (AMX( I ) ) 9904 .70 08, 7006 

7006  WSISWSI+AIX(I) 

C  SUM  UP  TOTAL  (X)  MASS  IN  GRID, 

TMXZ=AMX ( I ) +TMXZ 

C  CALCULATE  THE  SPECIFIC  INTERNAL  ENERGY 

C  FOR(X)  MATERIAL  IN  CELL  K. 

AIX(I)=AIX(I)/Ar:X(I) 

7008  WS=AMX ( I ) +AMD ( I ) 

C  CALCULATE  RADIAL  AND  AXIAL  VELOCITIES  BY 
C  CONSERVING  BOTH  COMPONENTS  OF  MOMENTA. 
U(I)=U(1)/WS 
V(I)=V(I)/WS 

C  SUM  UP  TOTAL  EK'RGY  IN  SYSTEM. 

ETH=( (U(I) **2+V (I ) **2 ) /2 . ) * WS+WS I +ETH 
GO  TO  7012 

C  SET  FLAGS  FOR  TYPE  OF  MATERIAL  IN  CELL  K. 

7012  IF  (AMX( I) +AMD  CD  ) 2000 ,2000 .2001 

2000  DKE(I)=0. 

GO  TO  7015 

2001  IF(AMX(I)  )2002,. -.002, 2003 

2002  DKE(I)=-1. 

GO  TO  7015 

2003  IF (AMD ( I )) 2004.2004,2005 

2004  DKE(I)=-2,0 
GO  TO  7015 

2005  DKE(I)=1.Q 
7015  CONTINUE 

TMZ=TMDZ+TMXZ 

WRITE  (6.8072) ETH » E » TMDZ , TMXZ , TMZ 

IWS=ND-1 

IWSA=MMAX-ND 

IWSBsNMAX-1 

WRITE  (6.8073) ( IWS. IWSA. IWSB) 

7113  REWIND  N7 
C 

C  WRITE  TAPE  FOR  THE-  TOIL  CODE, 

C 

IF (PROB) 7162,7162. 7163 
7163  N3=0 
7162  WS=555.G 

WRITE  ( N7 ) VIS » CYCLE , N3 
WRITE  (N7) (Z(I) ,I=1»MZ) 

7131  WRITE (N7) (UOO »V(K) , AMD(K) » AMX(K) , AID (K) ,AlX(K) , 
1AIX(K) ,OKE(K) ,K=1,KMAXA) 

GO  TO  7140 


OUTPlilo 

OUTP1120 

OUTP1130 


OUTP1170 

OUTP1180 

OUTP1200 

OUTP1210 

0UTP123C 


OUTP1250 

OUTP1260 

OUTP1270 

OUTP1280 

OUTP1290 

OUTP1300 

OUTP1320 

0UTP1330 

OUTP1350 

OUTP1360 

OUTP1370 

0UTP13G0 

OUTP1390 

OUTP1400 


OUTP1420 


flflOO 


7140  CONTINUE 

WRITE (N7) (X(K) #TAU(K) »K=1#IMAX) 
WRITE CN7) (Y<K) #K=1» JMAX) 
WS=666.0 


7180 

7185 

7517 


9901 


9904 


OUTP1430 

OUTP1460 

OUTP1470 


EDIT  OUT  THE  VELOCITIES#  MASS 
AND  SPECIFIC  INTERNAL  ENERGIES  AS  A  FUNCTION 
OF  J  FOR  ALL  I  . 

7161  WRITE  ( N7 ) WS # WS # WS  OUTP1530 

REWIND  N7  OUTP1540 

WRITE  (6#8120)T#NC  OUTP1550 

IWS=IMAX*JMAX+1  OUTP1560 

CALL  SLITE  (0)  OUTP1570 

DO  7517  1=1# I MAX  OUTP1580 

CALL  SLITE  (1)  OUTP1590 

U=JMAXA  OUTP1600 

K=IWS+I  OUTP1610 

DO  7517  JP=1#JMAX  OUTP1620 

J=J-1  OUTP1630 

K=K-IMAX  OUTP1640 

7170  IF(AMX(K)+AMD(K) ) 9905 #7517 #7175 

7175  CALL  SLIT£T(1#K000FX)  0UTP1660 

GO  T0(7l80#7185) »K000FX  OUTP1670 

C  PRINT  OUT  CELL  QUANTITIES. 

7180  WRITE  (6*8080) 1#X(I) »DX(I)  OUTP1680 

7185  WRITE(6#8084)J»Y(J)fDY(vJ)»U(K)»V(K)#AID(K)»AIX(K)»AMD(K)»AMX(K) 

7517  CONTINUE  OUTP1710 

IF  (QOOOFD7520  #7520 ,7616  OUTP1720 

7616  CONTINUE 

GO  TO  7520  OUTP1820 

C  ERROR  OUTP1830 

9901  NK=7013  OUTP1840 

GO  TO  9999  OUTP1850 

9902  NK=7014  OUTP1860 

GO  TO  9999  0UTP1870 

9904  NK=7005  OUTP1880 

GO  TO  9999  OUTP1890 

9905  NK=7170  0UTP1900 

9999  WRITE  (6#8808) NK» I # J»K»L#M#N  OUTP1910 

PRINT  8888 »NK» I»J»K#L#M#N  OUTP1920 

CALL  DUMP  OUTP1930 

7520  RETURN  '  OUTP1940 

C  FORMATS  OUTP1950 

80720F0RMAT ( 1H  ////6H  THE  =1PE16.9# 7X#3HE  =E16,9///5H  K*  =L11.5#5X#4HKX0UTP196q 

1  =E11.5#7X»7HM.+MX  =E11.5)  OUTP1970 

8073  FORMAT (1H0/17H0PARTICLES  - 112# 4H  D0TI14#2H  XI14#6H  ToTAl)  OUTP1980 

80800FORMAT(lH0///3H0I=I2#10X#2HA=lPE13.7#10X»3HDX=E13.7/3H0  JlOX# 1KY130UTP1990 

1X»2HDY12X» 1HU13X# 1HV12X#  3HAID11X#  3HAIX11X#3HAMD11X»  3HAMX)  CUTP2000 

6084  FORMAT ( I3#3X# 1P8E14.7)  OUTP2010 

8104  FORMAT (1H  /31H  THERE  ARE  NO  MORE  PACKAGES——)  OUTP2060 

0120  FORMAT ( 1H  ///18H  TAPE  DUMP  AT  TIMEF1Q.1#7X*5HCYCLEI4)  OUTP2070 

6888  FORMAT (1H+/26H10UTPUT  ERROR  IN  STATEMENTS#  12X#  12H  INDICES  ARE6I7) OUTP2080 
END  OUTP2090 


ooo  '  ooooo’^ooHo 
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SUBROUTINE  pHl 

A  TWO  MATERIAL  OIL 

NOTE##  THE  FOLLOWING  SET  OF  DIMENSIONS# 

COMMON#  AND  EQUIVALENCE  ARE  TO  BE  USED 
FOR  ALL  SUBROUTINES  EXCEPT 
THE  CARDS  ROUTINE 

dimension 

DIMENSION  AM( 130) »  XL (130 ) »  YL(130)» 

1U(450Q) »V(4500) # AMD (4500) »AMX<4500) » AID(4500) »AIX(4500) # 

2P (4500 ) #DKE(4500) #THETA(4500) » 

3IWK130)  »W2(30)» 

4DXU00)  #X(100)  # XX (101)  #DY(100)  #Y(100)  »YY(101) » 

5TAB(15)#  AMK(15)  #  PK(15)#  QK(15)#  2U50)#  IZ(150)» 

6TAU(100) #PL(200) #PR(200) #UL(200) »UR(200) » 

7FLEFTU00)  #YAMC(100)  #  SIGC(100)#  GAMC(lOO) 

DIMENSION  DMASL(130) #DXML(l30) »DYML(130) #DENRG(130) 


COMMON 

7 

#XX 

»UR 

#PR 

# THETA 

»YY 

COMMON 

AID 

#  AIX 

#AM 

#AMD 

#  AMX 

t  AREA 

COMMON 

PIG 

i BOUNCE 

#DDXN 

»DDVK 

#DVK 

#DX 

COMMON  ' 

DY 

»Fp 

#FS 

#FX 

»OUT 

COMMON 

P 

t PA80VE 

#PBL0 

#PIDTS 

rPPABOV 

#PRR 

COMMON 

PUL 

t  DOT 

#RC 

#REZ 

#  RHO 

»RL 

COMMON 

RR  #  SlG  t 

O0G0FL#SWITCH 

»TABUM#TAU 

COMMON 

TAUDTS 

»  taudtx 

#U 

#UK 

#URR 

#UT 

COMMON 

UU 

# J'JU 

»UTEF 

»UVMAX 

»V 

►VABOVE 

COMMON 

VBLO 

#V£L 

»VK 

» VT 

#VTEF 

#VV 

COMMON 

VVA30V 

rWBLO 

#W2 

»W3 

»WPS 

»WS 

COMMON 

WSA 

#v>S3 

#  Vise 

»XL 

»XLF 

#XN 

COMMON 

XR 

t  YL 

» YLW 

» YN 

» YU 

»ZMAX 

COMMON 

I 

#11 

» IN 

#IR 

#IWS 

t  IWSA 

COMMON 

IWSB 

#  i  use 

#IW1 

#  J 

» JN 

»JP 

COMMON 

JR 

fX 

#kn 

#KP 

»KR 

#KRM 

COMMON 

L 

#M 

»MA 

#MB 

#MC 

»MD 

common 

ME 

t  M2 

#N 

#NK 

#  NKMAX 

#  NK1 

COMMON 

NO 

#.<R 

E  Q  U 

7  V 

A  L 

E  N 

C  E 

OEQUIVALENCE 

(Z# iZ#PROB) # 

(Z(2) »CYCLE) # 

0(3)  # 

DT)  , 

1(Z(4) iPRINTS) # 

(Z(5) »PRINTL) » 

(Z(6) #DUMPT7) # 

(Z(7) # 

CSTOP)  # 

2(Z(Q)  »PIDY) # 

(Z(9) »TMZ) # 

(Z(10) #GAM) # 

(Z(ll) 

#GAMD)  # 

3(Z(12)»GAMX)» 

(Z( 13) #ETH) » 

(Z( 14) # FFA) » 

(Z( 15) 

»FFB)  # 

4(Z(16) #TMDZ) » 

(Z(17)#TMXZ)# 

(Z( 18) #XMAX) # 

(Z(19) 

# TXMAX) » 

5 (Z(20) #TYMAX) » 

(Z(21) #AMDM) 9 

(Z (22) » AMXM) # 

(Z(23) 

»DNN)  » 

6(Z(24)#0MIN)» 

(Z(25) »FEF) # 

(Z(26) »DTNA) # 

(Z(27) #CVIS) # 

7(Z(28)»NPR)» 

(Z(29) #NPRI) » 

(ZOO)  »NC)  # 

(Z(31) 

#  NPC)  # 

8JZ(32)  #NRC) » 

(Z(33) # IMAX) » 

(Z(34) » IMAXA) » 

(Z(35) 

#JMAX) » 

9(ZOb) » JMAXA) » 

(Z(37) »KMAX) » 

(Z(38) fXMAXA) » 

(Z(39) 

#MMAX) 

OEQUIVALENCE 

(Z(40) #ND) » 

(Z(41) »KDT* # 

(7.(42) 

# IXMAX) » 

1003) »N9D) » 

( Z ( 44 ) #NOPR) » 

(Z(45)#NT  aX)» 

(Z(46) 

#NJMAX) » 

2(Z(47) #11) » 

(Z(48) #12) # 

0(49)  »Ic  - 

(Z(50) 

*  1 4 )  # 

3(Z(bl) »N1) # 

(Z(b2) »N2) » 

(7.(53)  » N3 /  . 

(2(54) »M4) # 

4(Z(55) #N5)» 

(Z(b6) »N6) » 

(Z (57) #  N7 ) # 

(Z (58) 

»N8)  # 

5 ( Z ( 69 ) #N9) • 

(Z(o0) »N10) # 

(Z(6l) »N11) » 

(2(62) 

»NRM) # 

PHI  003 


EDIT006Q 

ECIIT0070 

EDIT0080 


EDIT0130 

EDIT0150 

ECfITO.160 
EDIT0170 
EDIT0180 
EDIT0190 
EDIT0200 
EDIT0210 
EDIT0220 
EDIT0230 
EDIT0240 
EDIT0250 
EDIT0260 
EDIT0270 
EDIT0280 
EDIT0290 
EDIT0300 
EDIT0310 
EDXT0320 
EDIT0330 
EDIT0340 
EDIT0440 
EDXT0450 
EDIT0460 
EDIT0470 
EDIT04^0 
EDIT0490 
•EDIT0500 
EDIT0510 
EDIT0520 
EDIT0530 
EDIT0540 
ED I TO 550 
EDIT0560 
EDIT0570 
LOIT0580 
EDIT0590 
EDIT0600 
EDIT0610 
ED IT 0620 


JW»JJLP  Wl-I|l|l  IIJ-  Jl-  U  ■»»  ||  j  HjMUMWip 


So 


if 

f 


t 


[i 

i 

h 


l 


C 


c 

c 

c 

c 

:C 

c 

-C 

c 

c 

c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 


6(2(o3) >TRAD) t 
7(Z(t>7)  » RADER)  » 
8(Z(7i)  >REZFCT)  t 
9(Z(7S) t TOZONE) » 
OEQUI VALENCE 
1(Z(82) »CABLN) • 
2(Z(  oo)  t  WSGD )  t 
3(Z(90) »S1) , 
4(2(94)  »S5)  t 
5(Z(9b) » S9) , 


(Z(04) fXMRG) » 
(Z(b8) >RADET) * 
(2(72) fRSTOP) » 
(Z(76) f ECK) » 

(Z { 79) >  X2) t 
(Z(83) f VISC) » 
(Z(87) #WSGX) t 
(Z(91)»S2) f 
(Z(95) fS6) t 
(Z(995  »S10) 


( Z (65) iSN) f 
(Z(69) rRADEB) » 
(Z(73) » SHELL) r 
(2(77) »S80UND) » 
(Z(80) »Y1) # 
(Z(845  *T) t 
(Z(88) »GMACR) » 

( Z ( 92) »S3) r 
(Z(96) »S7) » 


(UR»UL»FLEFT) » 
(OKE»THETA) » 
(UR (46) »QK) t 


OEOU I VALENCE  (XX (2) #X(1) ) » 

1(PR(1U0) »SIGC) »  (PRf PLjGAMC) i 
2(UR( lb) r AMK) »  (UR(31) »PK) t 

equivalence  (am*o:'.asl)  >  (xl*dxml)  , 

l(YLfUYML) t  (1W1»D“MRG) 

DIMENSION  PLOT (10) 

DATA  PLCT/iH  1 1HX  -  1H.  r  lHM»  1H-/ 


(Z(66) »DXN) t  EDIT0630 
(Z(70) »DTRAD) »  EDIT0640 
(Z(74)  ABOUND)  f  EDIT0650 
(Z(78)»X1)  EDIT0660 
(Z(8i) »Y2) t  EOIT0670 
(Z(85) »GMAX) >  EDIT0680 
(Z(89) »GMAXR) t  EDIT0690 
(Z(93)>S4)»  EDIT0700 
(Z(97) »S8) t  EDIT07I0 
EDIT0720 
EDIT0730 
(UR ( 100 ) » YAMC) » EDIT0740 
(URf TAB) »  EDIT0750 

(YY(2)»Y(1))  EDIT0760 


00000030 


INPUT  READS  THE  TOIL  DUMP  TAPE  OR 
WILL  CALL  SUBROUiCNE  SET’UP  WHICH 
WILL  MA.\£  A  DUMP  TAPE  FOR  CERTAIN  TYPES  OF  PROBLEM 
CALL  INPUT 

CDT  ROUTINE  CALCINATES  DT (HYDRO  TIME  STEP) 

AND  PRESSURES »  A*. VANCE  CYCLE  NO.  ETC. 

10  CALL  CDT 

IN  EDIT t  DETERM IT  i  WHETHER  TO  EXECUTE  A  LONG 
PRINT t  A  SHORT  PR\NT,  A  TAPE  DUMP t  ETC.  AND 
CALCULATE  TOTAL  ENERGY  IN  SYSTEM (COMPARE 
WITH  ETH)  TOTAL  f  \SS,  INTEGRATE  TOTAL 
COMPONENTS  OF  MOT  INTA. 

CALL  EDIT 

CALL  SLITET  ( 1 fKOVOFX) 

SENSE  LITE  1  SIGNIFIES  THIS 
is  the  last  cycle  of  this  run  $sssssss$$$ss$$ 

LITE  TURNED  ON  IN  THE  EDIT  ROUTINE  ****** 

GO  T0(30»20)  rKOi'OFX 

PHI t  INTEGRATE  THE  MOMENTA  EQSo  INTEGRATE 
ENERGY  EQUAT’ON(ONlY  CHANGES  DUE  TO  WORK 
TERMS).  NO  MOVEMENT  OF  MASS  HERE 
20  CALL  PHI 

TRANSPORT  MASS  ACROSS  BOUNDARIES  (SOLVE 

NASS  TRANSPORT  EQ.)  TRANSPORT  TERMS  IN 

THE  MOMENTA  AND  ENERGY  EQS.  LEFT  OUT  OF 

PHI »  HERE  APROX: MATEO  BY  MASS  MOVEMENT.  CONSERVE 

MASS t  MOMENTA  AND  TOTAL  ENERGY, 

CALL  PH2 
GO  Tu  10 
30  CALL  EXIT 
ENO 


oUdROUTINE  INPUT  INPUU04n 

*  •*  +  +  >  ..**.;.*  A  2  MATERIAL  OIL  CODE  **********************•}•;:*** 

■  A  t.  :»LITE  (3)  .VNPUIOSO 


t 


v>  r> 


81 


READ  IN  COUNTER#  FOR  THE  NO#  OF  HEADER  CARDS# 
READ (5# 8009) II 
«:o09  FORMAT  (613) 

C  READ  IN  THE  HEADER  CARDS. 

DO  8010  1=1 # I I 
READ  (5*8004) IWS 
WRITE  (6*8004) IWS 
3010  CONTINUE 
6  CALL  CARDS 

C  NOTE#  OPTION  FOR  CALLING  SETUP. 

IF(PK(3) )  8887*8888*8888 
8888  CALL  CARDS 
CALL  SETUP 
8887  CONTINUE 
C  READ  TAPE 

GO  TO  1000 
10  CONTINUE 
CALL  CARDS 

C  execute  RES 

GO  TO  2000 
C 

:  40  CONTINUE 

C  DECREASE  T  8Y  DT»  SINCE  CDT  ROUTINE 

C  INTEGRATES  THE  TIME. 

T=T-OTNA 

C  ALSO  CYCLE  NO. 

NC=NC-1 

CYCLE=NC 

C  AND  NO.  OF  CYCLES  BETWEEN  ENERGY  CHECKS. 
NPC=NPC-1 
UVMAX=0.0 

C  GENERATE  DX  AND  DY  FOR  ALL  I  AND  J 
C  SINCE  THEY  hRE  NOT  ON  THE  DUMP  TAPE. 
DX(l)=X(li 
DO  50  I=2*J.MAX 
50  OX(I)=X(I)-X(I“l> 

DY(1.)=  Y(l) 

DO  55  J=2*JMAX 
55  DY( J)^YlJ)-Y(J-l) 

C  EDIT  OUT  THE  Z  BLOCK. 

K=1 

DO  80  1=1*3 
L=K+8 

V.RlTE(6*8005)K*  (Z(N) *N=K*L) 

80  K-“L+1 
K=28 

DO  81  1=1  *  4 
L=K+8 

V.RITE(6*3Q06)K*  (IZ(N)  *N=K»L) 

81  K=L+1 
K=62 

DO  82  1  =  1 » 10 
L=K48 

.■.RlTEdjBOOSJK*  (Z(N)  *N=K*L) 

82  K=L+1 

8u05  FORMAT ( 14 i IX r 1P9E12.5) 


INPU1060 


INPU1080 

INPU1090 

INPU1120 


INPU1270 

INPU1280 

XNPU1340 

XNPU1350 

XNPU1360 

INPU1370 

XNPU1380 

XNPU1390 


INPU1400 

XNPU1410 

XNPU1420 

INPU1430 

INPU144Q 


INPU1470 


INPU1490 
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8006  FORMAT ( 14* 1X> 917) 
60  TO  10000 


C 

C 

Q 

C**** 

1000 


1003 

.1004 


INPU1600 

INPU1610 

INPU1620 

INPU1630 

INPU1650 

INPU1660 


C 

c 


1006 

1010 

1011 

1016 

• 

1019 

1020 
1022 

1023 


1024 


1034 

1036 

1038 

1040 

C**** 

c 

c 

c 

c 

c 

2000 

2005 

2010 

2012 

2015 

2020 


READ  TAPE 
MZ=150 
IWS=0 
REWIND  N7 
READ(N7)PR<1)  > PRH)  *N3 

NR  =  NU;-.-3ER  OF  RECORDS  INPU1690 

NOTE  *****  INPU1700 

NR=N0*5 

IF (PR (1) -555*0) 1010*1016* 1010  INPU1720 

IWSSIWS+1  INPU1730 

IF  ( MOD  (IWS*  3))  990:'*  9902*  1003  INPU1740 

IF (PR (2) ) 1010 *101C; 1018  INPU1750 

CHECK  FOR  CORRECT  CYCLE  NO. 

IF l PK (2) -PR (2) )  10,' 3*  1023*  1020  INPU1760 

DO  1022  L=2*NR  INPU1770 

READ(N7)DUM 

GO  TO  1004  INPU1810 

REAJ(N7)  (Z(I) »I=1;MZ) 

CHECK  FOR  CORRECT  PROBLEM  NO. 

I F ( AdS ( PR08-PK { 1 ) )  -.01)1024*1024*9901  INPU1830 

REA0(N7) ( U ( I ) *  V ( I ) jAMD(I) »AMX(I) r  A ID ( I ) *AIX(I) * 
ip(I)*dke(I)»i=i»k;  axa) 

READ(N7) (X(K)*TAU(K) »K=1*IMAX) 

REA0(N7)(Y(K)»K=1:JMAX) 

REA0(N7)PR(1) *PR(P) »PR{3) 

IF(PR(1) -555.0)99*  4*1040*1038  INPU1960 

IF (PR (2) -666. 0)99*  3*1040*9905  INPU1970 

60  TO  10  INPU1980 

EMC.  OF  READ  TAPE  .‘********************«**«**********v************INPU1990 

INPU2000 

INPU2010 

INPU2020 

CALCULATE  MAXIMUM  GAMMA  AND 
GAMMA/ (GAMMA-1.)  FOR  EACH  MATERIAL. 


.2025 

'2030 

c 


IF (WbGX) 9906*2010; 2005 
GAMX=1.0/(WSGX-1.0) 

WSGX= ( GAMX+1 . 0 ) /GAMX 
GMAXR=GAMX*WSGX 
IF (ft^GD) 9907*2020 >2015 
GAML>=1  •  0/  ( WSGD-1 . 0 ) 
h SGD= ( GAMD+1 . 0 ) /GAMD 
GMA.DR— GAMD*i'/SGD 
GMAa=WSGD 

IF ( UbGD-WSGX ) 2025 » 2030  *  2030 

GMAX-WSGX 

GO  TO  40 


INPU2040 

INPU2050 

INPU2060 

INPU2G70 

INPU2030 

INPU2090 

INPU2100 

INPU2110 

INPU2120 

INPU2130 

INPU2140 

INPU2150 


ENo  OF  R  E  S  *****************v******^****#************#**********lNPU2160 

INPU2170 
INPU2180 

ERROR  INPU2190 

9901  NK=1023  INPU2200 

GO  TO  9999  INPU2210 


o  o  o  o  <*>  o  <Vo  o 
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9902  NK=10ll 

GO  TO  9999 
9904  NK=l036 

GO  TO  9999 
,  9905  NK=1038 

GO  TO  9999 

9906  NK=2000 

GO  TO  9999 

9907  NK=2012 
9999  NR=i 

CALL  DUMP 
C 

10000  RETURN 
C 

c  formats 

8000  FORMAT (7E11.3» 12) 
80040FORMAT(I1»71H 
1 
c 

END 


INPU2220 

INPU2230 

INPU2240 

INPU2250 

INPU2260 

INPU2270 

INPU2280 

INPU2290 

INPU2300 

INPU2310 

INPU2340 

INPU2350 

INPU2360 

INPU2370 

INPU2380 

INPU2390 

INPU2400 

INPU2410 

INPU2430 

INPU2440 


SUBROUTINE  SETUP.  c  •  n  m 

oimension 

TWO  MATERIAL  SETUP 
PACKAGES  MUST  BE  RECTANGLES. 

ASSUMPTION  OF  =  DX  AND  =  DY 
LOAD  PK(4)=1. 

LOAD ( PK ( 5 ) =R I GUT  BOUNDARY.  OF  PELLET II). 

LOAD  PK(6)sB0TT0mJ)+l  OF  PELLET. 

MB-PK (6) 

LOAD  PK(7)=TOP(U)  OF  PELLET. 

MCsPK(7) 

LOAD  PK(8)=1. 

MD=PK(8)  _  _.nrc.T 

LOAD  PK (9) =RI6HT (I) BOUNDARY  OF  TARGET. 

ME— PK ( 9 ) 

LOAD  PK(10)=BOTTOM(J)-M  OF  TARGET. 

MZ=PKllO)  . „ 

LOAD  PKCll>=TOP(J>OF  TARGET. 

LOAo'lNITIAL  DENSITY  INTO  ZU1S)  FOR  (X) MATERIAL 

F°NDTmi6°JF0RlTHE  DOT  MATERIAL  (TARGET)) 

LOAD  INITIAL  PELLET  VELOCITY  INTO  2(112). 
VT£F=Z(112) 

KMAX=IMAX*JMAX+1 

KMAXA=KMAX+1 

JMAXA=JMAX+1 

IMAXA=IMAX+i 

CLEAR  ALL  CELL  ARRAYS. 

DO  1  K=1»KMAX 
U(K)=0,0 


EDIT0060 

EDIT0070 
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V(K)=0,0 

P(K)“Q.Q 

AMXUO-O.O 

AIX(K>=0.0 

AID(K)=0. 

AMD(K)=0. 

DKE(K)=0. 

1  CONTINUE 
DX(I)=DX(1> 

X (1)~DX(1) 

WS=X ( 1 ) **2 
PIDY=3. 1415927 
TAU(1)=WS*P1DY 

C  CALCULATE  DX#XpTAU 
DO  10  I=2>IMAX 
Xa)=X(I-l)+DX(l) 

DX(lj=DX(l) 

WSA=X(I)**2 
TAU(I)  ~PIDY*(WSA“\'S) 

WS-WSA 
10  CONTINUE 
Y(l)=OY(l) 

C  calculate  DY  ANO  Y. 

DO  20  J=2»JMAX 
Y(J)=Y(J-1)+DY(1) 

DY(J)=DY(1)  ‘ 

20  CONTINUE 
ETH=0.0 
DO  30  I=M»MA 

KS(MB-1)*IMAX+I+1  , 

C  CALCULATE  MASS*  A.‘  0  VELOCITY  OF.  PELLET. 
DO  40  U=MB»MC 
AMX(K)=Z1115>*0Y<>')*TAU<I) 

V(K)=VTEF 

C  CALCULATE  TOTAL  El  IRGY  (ETH.) 

ETH=ETH+ AMX ( K ) *  <  V ( K ) **2 ) /2 . 0 
DKE(K)=-2. 

40  K-Kf IMAX 

30  continue 

C  CALCULATE  MASS  OF  TARGET. 

DO  50  I=MD»ME 
K=(MZ-l)*IMAX+I+i 
DO  60  J=MZ»N  ,,  % 

AMDCK)=Z(116)*DY( J)*TAU(I) 

OKE(K)=-l. 

60  K=K+IMAX 
50  CONTINUE  ’ 

IMAX=IMAX 

JMAX=JMAX 

SHELL=2.0 

CYCLE-0.0 

DT=0.0 

NMAX=0 

XMAX=X(IMAX) 

TXMAX=XMAX*2.0 
YMAX=Y (UMAX) 

TYWAX=YMAX*2.0 


o  o  c> 


C 


DUMP  ON  TAPE  N7 


S3  . 


WRITE  STARTING  CONDITIONS  F0R  TOIL 


REWIND  N7 

WRIT£(N7)WS»CYCLE*N3 
WRITE(N7)(Z(I) *1=1*150) 

WRITE(N7)(U(I)#V(T),AMD(I)»AMX(I)»AID(I)»AIX(I)» 

1P(I)»DK£(I)»I=1»KMAXA) 

WRIT£(N7)  (X(I)  #TAU(I)  *>1=1#  IMAX> 

WRITE (N7)  (Y(I)*I=1»JMAX) 

WS=666.0 

WRITE(N7)WS»WS*WS 
REWIND  N7 
RETURN 
END  ' 

C 

C 

SUBROUTINE  CARDS 

DIMENSION  TABLE (i) *CARD(7) *LABLE(1) 

COMMON  TABLE 

EQU I VALENCE! TABLE ( 1) ,LABLE(1) ) 

WRITE  (6»10) 

1  READ  (5*11) IEND*l.OC*NUMWPC» (CARD(I) »I=1»NUMWPC) 

WRITE  (6*12)  IEND* i,OC»NUMWPC» (CARD! I) *I-1»NUMWPC) 

DO  4  I=1»NUMWPC 

U=LOC+I-l 
IF ( IEND-2) 2*5*2 
5  LABLE(J)=IFIX(CARD(D) 

GO  TO  4 

2  TABLE (J) =CARD ( I ) 

4  CONTINUE 

IF(IEND-I) 1*3*1 

3  RETURN 

c  •  FORMATS 

10  FORMAT (20H1TOIL  INPUT.  CARDS///) 

U  FORMAT  (11*15*11*  0P7E9  » 4 ) 

12  FORMAT (1H  I4»I7*I3*1P7E14.6) 

END 

C 

C 

SUBROUTINE  COT 
C 

Q  **********$****❖..-  S************************************ 

C  **********  a  2  MATERIAL  OIL  CODE  ********  ******************* 

C 

C*  Z(138)  FOR  DENSITY  CHECK* IF  CELL  K 

C  HAS  RHO  LESS  THAN  Z(138)  »NO  STABILITY  CHECK 

C  DONE  IN  CELL  K 

*C  IF  (CABLN)  GREATER  THAN  0,  THE  DT  LOADED  WILL  REMAIN 
C  CONSTANT • 

C  IF (CABLN)  =0.  CODE  CONTROLS  TIME  STEP  BETWEEN  FFAfFFB 

t  IF  (CABLN)  LESS  THAN  0.  CODE  CONTROLS* BUT  AT 
C  Z ( 139)  OF  STABILITY. 

C  $$$$$  Z(139)  IS  A  INPUT  NO.  ********** 


CARD0030 

CARD0040 

CARD0050 

CARD0070 

CARD0090 

CARD0100 

CARD0110 

CARD0120 

CARD0130 

CARD0140 

CARD0150 

CARD0160 

CARD0170 

CARD0180 

CARD0190 

CARD0200 

CARDQ210 

CARD0230 

CARD0240 

CARD0250 


CDT  0060 
CDT  0780 
CDT  0010 


CDT  1030 
CDT  1040 
CDT  1050 
CDT  1080 
CDT  1090 
CDT  1100 
CDT  1110 
CDT  1120 
CDT  1130 


o  o  o 
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3oOO  VEL=Q«0 
3005  DO  3050  1=1# II 
»3010  K=J+1 
3015  DO  3050  J=1#I2 
3020  IF ( AMX (K) +AMD (K ) ) 9901 #  3050  # 3025 
C 

C  CALL  EQUATION  OF  STATE 
3025  CALL  ES 

3030  IF(ABS(P(K> )-1.0E"10)3035r3035#3040 
3035  P(K)=0.Q 

3040  IF ( WSGX-VEL) 3050#  3050  #  3045 
3045  VEL=WSGX 
3050  K=K+IMAX 
3055  KDT=1 

UVMAX=-1.0 
3070  DO  3255  1=1# II 
3075  K=I+1 
3095  DO  3255  J=1»I2 
3100  KP=K+IMAX 

IF(AMX(K)+AMDCK) )990l#3255#4 

IF  THE  DENSITY  IS  LESS  THAN  Z<138)  WHICH  IS  A 
INPUT  NO#  THIS  CEIL  WILL  BE  BYPASSED 
FOR  STABILITY  CONSIDERATIONS. 

4  IF((AMX(K)+AMDiK))/(TAU(I>*DY<J>)-Z<138))3255»3255#3ll5 
3115  SI6=DX(I) 

3120  IF  (DY (J)-SIG) 3121" #3130 #3130 
.3125  SIG=DY(J) 

3130  IF (Z(l48) ) 4000 #4000 #4001 
C  SPEED  OF  SOUND  FOR  POLYTROPIC  GAS. 

4000  WS=SQRT ( GMAX*TAU ( i ) *DY ( U ) *ABS <  P  <  K ) ) / ( AMX  <  K ) +AMD (K) ) ) 

GO  TO  3205 

C  SPEED  OF  SOUND  FOR  METALS. 

4001  WSA=ABS(P(K))*1«E<4 

WS=Z  ( 148) +Z  ( 149 )  *  ( V/SA**Z  (150 ) ) 

WS=WS*leE-3 
3205  WS=WS/SIG 

3210  IF(UVMAX-WS)3215#3220»3220 
3215  N10=I 
Nll=J 
UVMAX=WS 

3220  IF(NMAX)1»1»2 

1  continue 

3  WS=ABS(U(K))/TAUU)*X(I)/.5*PIDY 
GO  TO  3225 

2  WS=ABS(U(K))/DX(I) 

3225  IF (UVMAX-WS) 3230 » 3235 # 3235 
3230  UVMAX=WS 
N10=I 
N11=J 

3235  WS=ABS(V(K))/DY(J) 

3240  IF (UVMAX-WS) 3245 » 3250 # 3250 
'*3245  N10=I 
NX1=J 
UVMAX=WS 
"3250  CONTINUE 
3255  K=K+IMAX 

C  SAME  TIME  CONTROL  OPTIONS  THAT 


CDT  l1 4Q 

CDT  i 

CDT  1200 
CDT  1320 


CDT  1340 
CDT  1350 
CDT  1360 
CDT  1370 
CDT  1380 
CDT  1390 

CDT  1410 

CDT  1430 
CDT  1440 


CDT  1450 
CDT  1460 
CDT  1470 
CDT  1480 


CDT  1500 
CDT  1510 
CDT  1520 
CDT  1530 
CDT  1540 
CDT  1550 
CDT  1560 
CDT  1570 
CDT  1580 
CDT  1590 
CDT  1600 
CDT  1610 
CDT  1620 
CDT  1630 
CDT  1640 
CDT  1650 
CDT  1660 
CDT  1670 
CDT  1660 
CDT  1690 
CDT  1700 


o  o  o  o 


t 


C*V  T  CT  TM  ATI 

N10  AND  Nil  CONTAIN  THE  COLUMN 
AND  ROW  NO.  OF  THE  CELL  THAT  IS 
CONTROLLING  DT. 

3260  IF(CABLN>90?91#3300 

90  IF(Z(105)~Z(139) ) 7901 » 7000 » 7000 
'7000  Z(105)=1. 

GO  TO  7002 

7001  Z(105)=Z(105)*Z<106) 

7002  OT=»5/VEL/UVMAX*Z( 139) *Z(105) 

GO  T0  3295 

91  WS=UVMAX*DT 
WSA~Q«5/VEL 

3265  IF ( FFA-WSA) 3276 » 3276 » 3270 
3270  FFA=WSA 

3276  IF ( WS-FFA ) 3285 » 3300 » 3280 
3280  OT=DT/WS*FFB/0.9 
GO  TO  3295 

3285  IF (WS-FFB) 3290 r 3290 #3300 
3290  DT=DT*FFA/WS*0.9 
3295  KOT=0 
3300  T=T+DTNA 

85  IF(DTRAD)9911#80»81 
•  80  NR=NRM 

84  WS=NR 

TRAD=DT/WS 
GO  TO  82 

81  IWS=DT/DTRAD 
NR=IWS+1 

83  IF (NR-NRM) 84# 84# 60 

82  NC=NC+1 
CYCLE=NC 
NPC=NPC+1 

3305  IF (T)9909#3320#3310 
3310  IF (KDT) 9910 #3315 #3320 
3315  WRITE  (6»8000)T»OTNA»DT 
3320  OTNA=DT 

GO  TO  3325 
9901  NK=3020 

GO  TO  9999 

9909  NK=3305 

GO  TO  9999 

9910  NK=331Q 

GO  TO  9999 

9911  NK=85 
9999  NR=2 

Q  i fc####*#**###*** 

CALL  DUMP  • 

30000FORMAT  { 17H0CHANGE  DT  •••  T=1PE9.3»11H 
HN+1)=1PE9.3) 

END 


DTCN)=1PE9.3#13H 


COT  1 
COT  1 
COT  1 
CDT  1 
COT  1 
CDT  1 
CDT  I 
CDT  1 
CDT  3 
COT  3 
CDT  3 
CDT  3 
CDT  3 
COT  3 
COT 
CDT 
CDT 
CDT 
CDT 
CDT 
CDT 
CDT 
COT 
CDT 
CDT 
CDT 
CDT 
CDT 
CDT 
CDT 
CDT 
CDT 
CDT 
COT 
COT 
COT 
COT 
CDT 
COT 
DTCDT 
CDT 
COT 


1730 
174Q 
1750 
1760 
1770 
1780 
1790 
1800 
1810 
1820 
1830 
1840 
1850 
1860 
1870 
1880 
1890 
1900 
1910 
1920 
1930 
1940 
1950 
1960 
1970 
1980 
1990 
2000 
2020 
2030 
’  2040 
•  2050 

r  2060 
r  2070 
r  2080 
r  2090 
r  2100 
r  2120 

r  2130 
T  2140 
r  2150 
T  2160 


SSSHS  AH2  MATERIAL  OIL  CODE  *************************** 


PHI  0030 


88 


C 

C  SINCE  WE  INITIALIZE  THE  BOUNDARY  CONDITION 
f.  AT  THE  LEFT  FOR  THE  FIRST  COLUMN *  AND  THE 

C  BOTTOM  BOUNDARY  CONDITION  OF  THE  FIRST  CELL* 

C  WE  NEED  ONLY  CONCERN  OURSELVES  WITH 
C  CALCULATING  QUANTITIES  AT  THE  TOP  AND  RIGHT 
C  OF  EACH  CELL*  SINCE  THE  LEFT  AND  BOTTOM 
C  HAVE  ALREADY  BEEN  CALCULATED. 

C  ******  STANDARD  PH.l  VELOCITIES  AT  CENTER  OF  CELL  ***** 

C  INTEGRATION  OF  VELOCITIES  AND  INTERNAL  ENERGIES 

C  REQUIRING  2  PASSES 

ETH1=0. 

NRT=0 

NRC=Q 

80OO  VEL-1.0 

C  INITIALIZE  MID-POINTS  OF  FIRST.  AND  SECOND  CELL 
C  IN  THE  R  DIRECTION. 

3301  RC=DX(l)/2.0 
RR=lXU)+X(2))/2.0 

C  AXIS  OF  SYMMETRY  BOUNDARY  CONDITIONS 

C 

3304  K=2 

DO  3302  J=1#JMAX 
PL( J) =P (K) 

UL(J)=0.0 

3302  K=K+IMAX 

C  FIRST  PASSr  CALCULATE  U  AND  V  TILDA »  AND 
C  THE  WORK  TERMS  USING  PRE-PHI  VELOCITIES. 

C  SECOND  PASS*  CALCULATE  ONLY  THE  WpRK  TERMS 

C  USING  THE  NEW  VELOCITIES  (U  AND  V  TILDA) 

DO  3360  1=1 » II 
8  K=I+1 

IF (CVIS) 7002*7003*7003 
C  BOTTOM  BOUNDARY  IS  TRANSMITTIVE. 

7002  VBLO=V(K) 

PBLO=0.0 
GO  TO  7004 

C  BOTTOM  BOUNDARY  IS  REFLECTIVE. 

7003  VBLO=0.0 
PBLO=P(K) 

7004  TAUDTS=TAU(I)*DT 
4  DO  3348  J=1*I2 

PIDTS=1 . 0/ (PIDY*DT*OY ( J) > 

C  K  IS  INDEX  OF  CELL  IN  QUESTION. 

C  N  IS  INDEX  OF  CELL  ABOVE, 

N=K+IMAX 

IF (VEL) 3305*3305*3303 

3303  CONTINUE  * 

3305  IF(AMD<K)+AMX(K> >9902*3340*3306 

3306  IF (IMAX-I) 9903* 3311 *3310 

3310  IF (AMD (K+l ) +AMX (K+l ) ) 9904 » 3312  *  3314 
C  WE  ARE  AT  THE  RIGHT  BOUNDARY  OF  THE  GRID* 

C  SET  PRESSURE  GRADIENT  TO.  ZERO*  AND  MODIFY 

C  ETH. 

'3311  PRR=PL(J) 

3307  ETH=ETH-PRR*U(K)/PIDTS*RC 
GO  TO  3313 


PHI  0990 


PHI  1010 
PHI  1020 
PHI  1030 


PHI  1090 


PHI  1100 
PHI  1110 


PHI  1120 
PHI  1130 
PHI  1140 
PHI  1150 
PHI  1160 


PHI  1240 

PHI  1250 
PHI  1260 
PHI  1270 

PHI  1280 
PHI  1290 
PHI  1300 

PHI  1360 


PHI  1370 
PHI  1380 

PHI  1400 
PHI  1410 
PHI  1420 


PHI  1430 
PHI  1440 
PHI  1450 


o  o  o  o  o  o*  ooo  oo  o  crsno 


89 


3312 

3313 


3314 

3315 

3316 


3318 

3319 

3320 


3322 

3323 


3324 

7001 


THE  BOUNDARY  CONDITION  FOR  A  EMPTY  CELL  ON 
THE  RIGHT *  THE  PRESSURE  AT  THE  RIGHT 
INTERFACED.  AND  THE  VELOCITY  IS  THAT 
OF  THE  CELL  CENTER. 

PRRD.Q 

URR=RC*U(K) 

60  TO  3316 

CALCULATE  PRESSURE  AND  RU  AT  INTERFACE  I 
PRR=(P(K)+P(K+1) )/2.0 
URR= ( U ( K ) *RC+U ( K+l ) *RR ) /2 ♦ 0 
IF  ( JMAX-J)  9905 , 33,18 * 3320 
SET  PRESSURE  GRADIENT  TO.  ZERO*  FOR  TOP  OF 
GRID*  AND  MODIFY  ETH. 

PABOVE=PBLO 

eth=eth-pabove*v ( k) /z . o*tauots 

GO  TO  3323 

IF ( AMD ( N) +AMX (N) ) C906* 3322 » 3324 
CELL  ABOVE  IS  EMPTY »  SET  TOP  BOUNDARY 
CONDITIONS,  PRESSURE  AT  TOP  SURFACED. 

AND  VELOCITY  =  TH./f  OF  CELL. 

PABQVED.Q 

VABOVE=V(K) 

GO  TO  3328 

CALCULATE  PRESSURE  AT  INTERFACE  (J) 
PABOVE=(P(K)+PCN))/2.0 
IF(CVIS) 7001* 3325 » 3325 
IF  (1-.J)  3325*  7000  *C905 

BOTTOM  BOUNDARY  CCMDITION  OF  GRID  IS  REFLECTIVE*' 
AND  WE  HAVE  ALREADY  SET  THE  CONDITIONS. 


PHI  1460 
PHI  1470 
PHI  1480 

PHI  1490 
PHI  1500 
PHI  1510 


PHI  1520 
PHI  1530 
PHI  1540 
PHI  1550 


PHI  1560 
PHI  1570 
PHI  1580 

PHI  1590 
PHI  1600 


BOTTOM  BOUNDARY  OF  GRID  IS  TRANSMITTIVE*  SET 
PRESSURE  GRADIENT  TO  ZERO  AND  MODIFY  ETH. 

7000  PBLO=PABOVE  PHI  1630 

ETH=ETH+PBLQ*V(K)/2.0*TAUDTS  PHI  1640 

C  CALCULATE  VELOCITY  AT  INTERFACE  (U> 

3325  VAB0VE=(V(K)+V(N)>/2.0  PHI  1650 

3328  IF (VEL) 9907*3404, 3400  PHI  1660 

C  CALCULATE  THE  U  AND  V  TILDA  QUANTITIES 
3400  V(K)=V(K)  +  (PBL0-P/30VE’I*TAUDTS/<AMD(K>+A'MX(K))  PHI  1670 

3402  U{K)=U(K)  +  (PL(J)S  RR)/(AMXIK)+AMD(K)  )*RC/PIDTS*2.0  PHI  1710 


C  CHECK  FOR  ADVANCING  ACTIVE  GRID  COUNTERS  IN 
C  THE  R  DIRECTION. 

3404  IF ( 1-11)6016*6005,6005 
6005  IF (U (K) ) 6605*6606,6605 

6605  NRC=1 

6606  1F(V(K) ) 6607* 6004* 6607 

6607  NRC=1 

6004  IF (AIX(K)+AID(K)) 6015* 6016* 6015 

6015  NRC=1 

6016  CONTINUE 

6044  wS= ( V8L0-V ABOVE) *TAUDTS/2 . 0*P ( K ) 

C  •  CALCULATE  THE  CHANGE  IN  INTERNAL  ENERGY 
C  DUE  TO  PRESSURE  FORCES  ONLY. 

OE=WS+( UL ( J ) -URR ) /PIQTS*P { K ) 

‘  3405  CONTINUE 

3331  IF (AMD(K) ) 9908*3332*3334 

3332  AIX(K)=AZX(K)+DE/AMX(K) 


PHI  1770 


GO  TO  3342 

3334  IF(AMXCK) ) 9909; 3336# 3338 
.  3336  AID(:0=AXD(K)+DE/AMO(K) 

GO  TO  3342 

C  CONVERT  TO  SPECIFIC  INTERNAL 

£  ENERGY  FOR  EACH  MATERIAL. 

3338  FS=AMX ( K ) /DKE ( K >  + AMD ( K ) / ( 1 . -DKE (K) ) 
WSD=DE/(1.-DKE(K) >/FS+AID(K> 

WSX=DE/OKE  ( K )  /FS+A  I X  { K ) 
lu22  AIX(K)=WSX 
AID(K)=WSD 
GO  TO  3342 

c  came  here  because  cell  in  question  is  empty. 

C  SET  INTERFACE  QUANTITIES  ASSUMING  CELL  ABOVE 
C  ANO  TO  THE  RIGHT  ARE  NOT  VOID. 

3340  PRR=0.0 

URR-U(K+1) *RR 

PA60VE=0.0 

VABOVE=V(N) 

C  SET  RIGHT  QUANTITIES  TO  THE  LEFT  (FOR 
C  NEXT  COLUMN  SWEEP)  AND  ABOVE  QUANTITIES 
C  TO  BELOW  FOR  NEXT  CELL  ABOVE. 

3342  VBLO=VABOVE 
:  PL(J)=PRR 

UL(J)=URR 
K=N 

•  3348  PBLO=PABOVE 

C  CHECK  FOR  ADVANCING  ACTIVE  GRID  COUNTERS 
C  IN  (J)  DIRECTION. 

LL=K-IMAX 

IF(U(LL))6000»600! #6000 

6000  NRT=1 

6001  IF(V(LL))6002»6003»6002 

6002  NRT=1 

6003  IF(AIX(LL)+AID(LL) ) 60l7#60l8# 6017 

6017  NRT=1 

6018  CONTINUE 
3355  RC=RR 

RR=(X(I+l)+X(I+2))/2.0 

3360  CONTINUE 

3361  IF ( VcL) 9911 » 7030 » 3363 
3363  VEL=0.0 

C  RECYCLE  FOR  SECOND  PASS. 

GO  TO  3301 

C  ERROR 

9902  NK=3305 

GO  TO  9999 

9903  NK=3306  * 

GO  TO  9999 

9904  NK=3310 

GO  TO  9999 
•'  9905  NK=3316 

GO  TO  9999 

9906  NK=3320 

GO  TO  9999 

9907  NK=3^28 

GO  To  9999 


90  ) 

PHI  1800 


PHI  2220 
PHI  2230 
PHI  2240 


PHI  2250 
PHI  2260 
PHI  2270 
PHI  2280 


PHI  2290 
PHI  2300 
PHI  2310 
PHI  2320 
PHI  2330 


PHI  2340 
PHI  22*30 
PHI  2360 

PHI  2380 

PHI  2390 
PHI  2400 
PHI  2410 
PHI  2420 
PHI  2430 
PHI  2440 
PHI  2450 
PHI  2460 
PHI  2470 
PHI  2480 
PHI  2490 
PHI  2500 
PHI  2510 
PHI  2520 


o  n  o 
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9908  NK=3331 

80  TO  9999 
.9909  NK=3334 

GO  TO  9999 
9911  NK=3361 
\  9999  NR=3 


CALL  DUMP  „  „ 

SET  VELOCITIES  AND  INTERNAL  ENERGY 
(FOR  SMALL  VALUES)  TO  ZERO. 

ALSO  NEGATIVE  INTERNAL  ENERGIES 

7030  DO  10  K=2.KMAX 

IF  (ABS(V  (K)  )-Z(146) )  3401  .  3401 . 11 
3401  ETH1-ETH1+  ( AMX(K)  :-AMO(K) )  /2.*(V  (K)  **2) 


ViK)=0. 

11  IF ( ABS(U (K) ) -Z< 14 6) ) 3403.3403. 12 
3403  ETHl=ETHl+(AMX(K)  :-AMD(K) ) /2.* (U(K)  **2) 
U(K)=0. 

IF ( ABS(AIX(K) )  -2(145))  8002.8002.8003 
8002  £TH1=ETH1+AMX(K)*AIX(K) 


8003  IFU8S(AID(K) )  -2(145))  8004.8004.8005 
:  8004  £TH1=ETH1+AMD(K):-AI0(K) 


AID(K)=0. 

8005  CONTINUE 

‘  10  CONTINUE  1IiTrnp 

C  INCREASE  ACTIVE  GRID  COUNTERS. 


Usll+NRC 

I2=I2+NRT 

cTH=ETH-ETH1 

IF (ll-IMAX) 6100 .6100. 6200 

6200  Il-IMAX 

6100  IF (I2-JMAX) 6201 .6201 .6202 
6202  12=UMAX 

6201  RETURN 
END 


C  _  .  .. . - _ _ _ _ _ — - - 

C  - - - - -  “ - 

c 

C  ***«*™»  aH2  MATERIAL  OIL  CODE  .**.»**.*.*»»*»»'■.»****«♦** 

c 

c  FOR  x  material 

c  AMPY  =  MASS  AT  TOP 

C  AMUT  =  radial  momentum 

C  AMVT  =  AXIAL  MOMENTUM 

C  OELET  =  SPECIFIC  ENERGY 

C 

C  FOR  DOT  MATERIAL 

C  TOM  =  MASS  AT  TCP 

’C  TOXM  s  RADIAL  MOMENTUM 

C  TDYM  =  AXIAL  MOMENTUM 

C  TOTE  =  SFECIFIC  ENERGY 

» 

C 

c  FOR  X  MATERIAL 

C  AM-/?  ~  MASS  AT  RIGHT 


PHI  2530 
PHI  2540 
PHI  2550 
PHI  2560 
PHI  2570 
PHI  2580 
PHI  2590 
PHI  2610 


PHI  2770 


PH2  0740 


OOOOOOOOOOOOOOT/OOOOOOOOOOO  0-0  o  r>  o  o 
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AMUR  =  RADIAL  MO.VNTUM 
AMVR  =  AXIAL  MOMENTUM 
DELER  =  SPECIFIC  ENERGY 

FOR  DOT  MATERIAL 
RDM  s  MASS  AT  RIGHT 
RDXM  =  RADIAL  MOMNTUM 
RDYM  s  AXIAL  MOMENTUM 
ROTE  =  SPECIFIC  ENERGY 


FOR  X  MATERIAL 
AMMY  =  MASS  AT  BOTTOM 
AMMU  s  RADIAL  MOMENTUM 
AMMV  =  AXIAL  MOMENTUM 
DELES  s  SPECIFIC  ENERGY 

FOR  DOT  MATERIAL 
BOM  =  MASS  AT  BOTTOM 
BDXM  =  RADIAL  MON..  NTUM 
BDYM  =  AXIAL  MOMENTUM 
BOTE  =  SPECIFIC  ENERGY 


FOR  X  MATERIAL 
GAMC  =  MASS  AT  THE  LEFT 
FLEFT  =  RADIAL  MO.  ENTUM 
YAMC  =  AXIAL  MOMENTUM 
SIGC  =  SPECIFIC  e:  ergy 

FOR  DOT  MATERIAL 
DMASU  =  MASS  AT  T:  E  LEFT 
DXML  =  RADIAL  MOM  ,!TUM 
DYML  =  AXIAL  MOME? TUM 
DENRG  =  SPECIFIC  .  NERGY 
ETH1=0. 

RECYC=0. 

NRT=0 
NRC-0 
REZ=0.0 

CALL  SLITE  CO) 
PIDTS=1.0/(PIDY*0T) 

C  SET  BOUNDARY  CONDITIONS  FOR  THE 

101  DO  103  J=1,JMAX 

102  GAMC (J) =0.0 
FLEFTC J)=0«0 
YAMC (J) =0.0 
SIGC(J)=0.0 
OMASL(J)=0. 

OXMLCJisO.- 

DYML(J)=0. 

DENRG (J)=0. 

103  CONTINUE 

t  BEGIN  DO  LOOP  ON  I 

104  00  547  1=1,11 
J=1 

•*  105  K=I+1 

80  I F ( AMX ( K ) + AMD ( K ) ) 9900 ,97,81 

81  IF ( V (X ) ) 82, 97, 97 


PH2  1020 
PH2  1030 
PH2  1040 
PH2  1050 
PH2  1060 

AXIS  OF  SYMMETRY' 

PH2  1070 
PH2  1080 
PH2  1090 
PH2  1100 
PH2  1110 


PH2  1120 

PH2  1130 
PH2  1140 
PH2  1150 


PH.2  1170 
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NO  MASS  FLUX 
AMMV=0 . 0 
BDYM=0 . 

GO  TO  98 

CHECK  BOTTOM  BOUNDARY  OF  GRID 

IF (AMX(K) ) 9900 » 2* 3 

DOT  ONLY 

ND=i 

GO  TO  6 

IF ( AMD (K) ) 9900 »4»  5 

X  OImuY 

ND=0 

GO  TO  6 

MIXED  CELL 

ND=~1 

MASS  OUT  OF  THE  BOTTOM  OF  THE  GRID 
WS=  ( AMX  { K )  +AMD  ( K ) )  *V  { K )  /DY  ( J )  *DT 
CHECK  FOR  MORE  THAN  EMPTYING  THE  CELL 
IFv/o+AMX(K)+AMD(l<)  )8»9»9 
AMMY=-AMX(K) 

BDM=-AMD(K) 

GO  TO  85 

THE  RESPECTIVE  FLUXES  ARE  PROPORTIONATE  70  THE  MASSES 
WSA=AMX(K)+AMD(K) 

AMMY=.vS*AMX(K)/WSA 

BOM-  .vS*AM0  (K)  /WSA 

IF(CVIS) 106? 99 » 99 

BOTTOM  BOUNDARY  IS  TRANSMITT IVE. 

WS= ( U ( K ) **2+V ( K ) * *2) /2 . 

IF(NO)UilO>ll 
X  MATERIAL  ONLY 
AMMU=A.v,MY*U(K) 

AMMV=AMMY*V(KJ 

DELEd=AIX(K)+WS 

eth=eth+ammy*deleb 

GO  TO  107 

DOT  FOR  SURE  AND  PERHAPS  X  ALSO 

6DXM-L0M*U(K) 

bDYM=6DM*V(K) 

BDTE-AIG  f  K) +WS 

eth=eth+bdm*bdte 

IF (Nj) 10 » l07» 107 

BOTTOM  BOUNDARY  IS  REFLECTIVE 

AMMV=2.*AMMY*V(K) 

BDYM=2.*BDM*V{K) 

AMMYsO. 

BDM=0. 

AMMUsO . 

60XM-0  ♦ 

DELE^-0  • 

BOTE-O • 

BEGlu  CO  LOOP  IN  THE  J  DIRECTION 

DO  S4o  J=1,I2 

L=K+  aMAX 

VEL=0.0 

FS-O.U 

HEo-  .  CALCULATION  OF  VABOVE. 


PH2  1180 


PH2  1340 
PH2  1350 
PH2  1390 
PH2  1400 


o  o  r>  o 


210  IF ( JMAX-J) 211»2ll >  207 
C  AT  TOP  BOUNDARY  OF  GRID. 

*  211  VEL=i.O 

GO  TO  208 

207  IF (AMX(L)+AMD(L) )215» 215.214 
:  214  IF(AMX(K)+AMD(K))?.16»2l6r209 

216  VA80VE=V(L) 

GO  TO  212 

215  IF(AMX(K)+AMD(K>  >205.205.208 
205  VABOVE-O.O 
GO  TO  212 

208  VABOVE=V(K) 

GO  TO  212 

209  VABOVE=(V(K)+V(L))/2.0 
212  CONTINUE 

C  NOW  WE  HAVE  V ABOVE 

C  BEGIN  CALCULATION  OF  URIGHT 

404  IF ( IMAX-I) 412.412.405 

405  IF(AMX(K+1)+AMD(K+1))411»411#409 

409  IF (AMX(K)+AMD(K) )  1‘  10 .410.407 

410  URR=U(K+1) 

GO  TO  408 

411  IF(AMX(K)+AMD(K>  )':03. 403.406 
1  403  URR=0.0 

GO  TO  408 

412  FS=i.Q 

•  406  URR=U(K) 

GO  TO  408 

407  URR=(U(K)+U(K+1) )/2.0 

408  CONTINUE 

109  CONTINUE  ,  , 

CHECK  HERE  FOR  EMPTYING  THE  PROJECTILE  FOR 
IMPACT  PROBLEMS 

ZU12)  =  INITIAL  AXIAL  VELOCITY. 

Z(113)  s  EPSIL0NICS»  LIKE  .05 

301  IF ( V ABOVE) 300 » 304 » 302 

302  IF ( AmX (K) +AMD (K) ) 9900 »304f8800 

8800  IF( J-l) 9900 » 303 » 8801 

8801  KP=K-IMAX 

IF ( AMX (KP) +AMD ( KP )) 9900 » 8803 » 303 
8803  IF(ABS(VAB0VE“Z(112) )/Z(112)-Z(113) ) 306 t 303 t 303 

303  M=K 
JJ=J 

GO  TO  307 

304  AMPY=0.0 
TOM=0. 

308  AMUT=0.0 
TQXM=0 . 

AMVT=0.0 

TOYM=0» 

DEl£T=0.0 

TDTt-=0. 

GO  TO  501 

300  IF(VEL)9901#305f304 
*  305  IF(AMX(L)+AMD(L))9903r304»306 
306  M=L 

0 J— J+l 


PH2  1410 

PH2  1420 
PH2  1430 


PH2  1460 
PH2  1470 

PH2  1490 
PH2  1500 
PH2  1510 
PH2  1520 
PH2  1530 
PH2  1540 


PH2  1580 


PH2  1610 
PH2  1620 

PH2  1640 
PH2  1650 
PH2  1660 
PH2  1670 
PH2  1680 
PH2  1690 
PH2  1700 


PH2  1720 

PH2  1740 
PH2  1750 

PH2  1770 
PH2  1780 
PH2  1790 
PH2  1800 
PH2  1810 

PH2  1820 

PH2  1830 

PH2  1840 

PH2  1850 
PH2  1860 

PH2  1880 
PH2  1890 


OOOOOOOOOOOOOOO  •  ooo. 
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307  IF (VEL) 6130 » 6130 *6140 
6130  WSA=(V(K)+V(L))/2,0 

WS3~1  »0+(  V(L)**V(K) ) /(DY( JJ)  *S80UNJ) *DT 
VABOVE=WSA/WSB 

HERE  WE  HAVE  CALCULATED  THE  MASS  FLUX  AT  THE  TOP* 
THIS  MAY  CONSIST  OF  BOTH  X  AND  DOT 
MATERIAL*  NO  DISTINCTION  YET. 

6 140  AMPY= ( AMX (M) +AMD (M) ) * V ABO VE/D Y ( JJ) *DT 

501  IF (URR) 500  *504*502 

502  IF ( AMX(K) +AMD (K) ) COO 0 # 504* 503 
'503  M=K 

N~I 

GO  TO  508 
504  AMMP=0.0 
AMUR=0 . 0 
AMVR-0.0 
DELER=0.0 
RDM=0. 

RDXM=0. 

ROYM-0. 

RDTE=0. 

GO  TO  9500 

500  IF(FS) 9905*506*504 

506  xF ( AMX (K+l) +AMD (K* i) ) 9904*504*507 

507  M=K+1 
N=I+1 

508  IF(FS)6100*6100*6U0 
5100  WSA=(U(K)+U(K+l))/». 

wsb=i.o+(u:k+1)-ulu)/(dx(n)*sbound)*dt 

URR=WSA/WSB 

5110  D£N=(AMX(M)+AMD(M) )/TAU(N) 

HERE  WE  HAVE  CALCULATED  THE  MASS  FLUX  AT  THE 
RIGHT*  THIS  MAY  Cf.iSlST  OF  BOTH  X  AND  DOT 
MATERIAL*  NO  DIST.- UCTION  MADE  YET 
AMMP=DEN/PIDTS*XC'  )/.5*URR 


PH2  1900 

PH2  1920 
PH2  1930 


PH2  1950 

PH2  1970 
PH2  1980 
PH2  1990 
PH2  2000 
PH2  2010 
PH2  2020 
PH2  2030 


PH2  2050 

PH2  2070 
PH2  2080 
PH2  2090 

PH2  2110 
PH2  2120 


PH2  2140 


BEGIN  HERE  TO  CALCULATE  THE  FLUX  FOR 
EACH  MATERIAL*  THE  FIRST  PASS  THROUGH* 

WE  CALCULATE  THE  f LUX  FOR  BOTH 
MATERIALS  (IF  NECESSARY)  AT  THE  TOP*  THE 
SECOND  PASS  IS  FOR  THE  RIGHT  SIDE. 

NOTE*  THE  RULES  TO  FOLLOW  FOR 
TRANSPORTING  OF  BOTH  MATERIALS  ARE 
EXPLAINED  IN  DETAIL  IN  THIS  REPORT 

9500  IF(AMPY) 13*26*4600 
4600  IF ( AMX(L)+AMD (L) ) 9900*170*14 
170  IF ( AMX (K) ) 171* 171  *  172 

172  IF ( AMD (K) ) 173* 173* 722 

'  171  CONTINUE 

174  TDM-AMPY 
GO  TO  733 

173  GO  TO  26 

13  IF(AMX(K)+AMD(K) )9900*190*14 
190  1F(AMX(L) )191»191*192 


192  IF(AMD(L>)193»193>23 

191  IF  (AMD  (L)  +  AMPY)  195#  194# 194 

194  TDM-AMPY 
GO  TO  733 

195  GO  TO  733 

193  IF(AMX(U+AMPY)197#26#26 
197  GO  TO  26 

14  IF(AMX(L))9900»16#18 

16  ND~1 

GO  TO  17 

18  IF(AMD(L) ) 9900 #19 #20 

19  ND=0 

GO  TO  17 

20  ND=-1 

17  IF(AMX(K) ) 9900 #73 #75 
73  NX=1 

GO  TO  720 

75  IF (AMD(K) ) 9900 #76 #51 

76  NX=0 

GO  TO  720 
51  NX=-1 

720  IF(AMPY)22#26#726 

22  1F(NX>24#25#25 

25  1F(N0) 15#193#28 

26  TOM=0. 

GO  TO  27 

24  IF (ND) 23# 193 #28 

23  IF(AMX(K)+AMD(K) )  975#975»976 

975  KK=L 

GO  TO  977 

976  KK=K 

977  WS=AMX(KK)+AMD(KK) 

WSA=AMPY 

AMPY=WSA*AMX(KK)/‘.'S 
TDM=WSA*AMD(KK)/WS 
252  CONTINUE 
GO  TO  27 

28  TDM=AMPY 

IF(TDM+AMD(L) )  73?. #732*733 

732  TDM  =  -AMD(U 

733  AMPY=0. 

GO  TO  27 

15  IF (NX)990Q»29»3l 

29  IF(AMX(L)+AMPY)32#26#26 

32  WS=AMX(L)+AMPY 
AMPY=-AMX(L) 

IF(AMX(L) )9401»9401»33 

9401  AMPY=0. 

33  IF(WS+AMD(L))35»34#34 

34  TOM=WS 
60  TO  27 

•'  35  TOM=-AMD(L) 

GO  TO  27 

31  IF ( AMD ( L) +AMPY ) 721 » 9940 » 9940 
"9940  TDM=AMPY 
aMPY=0. 

GO  TO  27 


721  TDM=-AMD(L> 

36  WS=AMD(L)+AMPY 

37  IF ( ttS+AMX <  L) ) 39  *  33 » 38 

38  AMPYsWS 
GO  TO  27 

39  AMPY=-AMX(L) 

GO  TO  27 

722  IF(AMX(L)+AMO(L) )  972>972#970 
972  KK=K 

GO  TO  971 

970  KK=L 

971  h-S=AMX(KK)+AMO{KK) 

WSA=AMPY 

ampy=wsa*amx(kk)/ws 

TDM=WSA*AMD(KK)/V/S 
182  CONTINUE 
9971  CONTINUE 
GA  TO  27 

726  IF(ND)41#40>40 

40  IF ( NX ) 42 » 730 » 171 
730  CONTINUE 

GO  TO  26 

41  IF (NX) 722# 173 # 171 

:  42  IF (NO) 9900 #60 #724 

60  IF(AMX(K)-AMPY)723»26#26 

723  WS=AMX(K)-AMPY 
AMPY=AMX(X) 

43  IF(WS+AMD(K) )46>45»45 

45  TOM=-WS 
GO  TO  27 

46  TOM=AMD(K> 

GO  TO  27 

724  IF(AMD(K)-AMPY)7p»128f 128 
128  TDM=AMPY 

AMPYsO. 

GO  TO  27 
70  TOM=AMD(K) 

WS=AMD(K)-AMPY 

47  IF (WS+AMXUO ) 49 » 48 #48 

48  AMPYs-WS 
GO  TO  27 

49  AMPY=AMX(K) 

GO  TO  27 

27  CONTINUE 

IF (RECYC) 152*150 >152 
150  RECYC=1. 

savei=ampy 

SAVE2=T0M' 

isavei=k 
ISAVE2=L 
9403  L=K+1 
;  9601  AMPY=AMMP 
TOM=0* 

GO  TO  9500 
■*  152  AMMPSAMPY 

ROM=TOM 
AMPYrSAVEl 
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TDM=SAVE2 

K=ISAVE1 

L=ISAVE2 

RF.CYC=0. 

C 

£  NOW*  WE  HAVE  THE  4  POSSIBLE  FLUXES# 

C  NOW  BEGIN  CHECKING  FOR  PREFERENTIAL 
C  MASS  MOVEMENT  BECAUSE  OF  CHOICE  OF 
C  INDEXING. 

C  THE  LOGIC  OF  CHECKING  INVOLVES  LOOKING 
C  AHEAD  IN  THE  J  AND  I  DIRECTIONS »  THE 
C  PROGRAM  CONTINUES  FOR  THE  NEXT  5 
C  PAGES  OR  SO  UP  TO  STATEMENT  NO.  5500 

C 

3006  IF(GAMC (J) +DMASL(J) ) 3007 #3002 >30 02 

3007  WS=AMX(K)+GAMC(U) 

WSA=AMD(K)+OMASL(J) 

GO  TO  3008 

3002  WS=  AMX(K) 

WSA=AMD(K> 

3008  IF ( AMMY+6DM) 30 09 »  TO 10 » 3010 

3009  WS=WS+AMMY 
WSA=WSA+BDM 

'  3010  IF (AMPY+TDM) 30 12 ? oQ13»3011 

3013  TF=0. 

GO  TO  3014 
•  3012  TF=-1. 

GO  TO  3014 
3q11  TF=1. 

3014  IF (AMMP+RDM) 3017 # 3016»3Q15 

3016  TR=0. 

GO  TO  3018 

3017  TR=-1, 

GO  TO  3018 

3015  TR=1.0 

3018  IF (TF) 3030 #30 19 #2019 

3019  IF (TR) 3025 #3025 >3020 

3020  IF ( WS-AMPY-AMMP) 3021 » 3022r 3023 

3021  WSS=AMPY+AMMP 
AMPY=AMPY/WSS*WS 
AMMP=AMMP/WSS*WS 

3022  IF (WSA-TDM-RDM) 3023 #3024#  3024 

3023  WSS=TDM+RDM 
TDM=TDM/WSS*WSA 
RDM=RDM/WSS*WSA 
GO  TO  3024 

3025  IF ( WS-AMPY ) 3026  >  3027 # 3027 

3026  AMPY=WS 

3027  IF ( WSA-TOM) 3028 > 3100  # 3100 

3028  TDM=WSA 
GO  TO  3100 

'  3030  IF (TR) 3100  f 3100  >  3040 
3040  IF ( WS-AMMP) 3050 > 3051 » 3051 
2050  AMMP=WS 

r  3051  IF (WSA-ROM) 3052# 3100 #3100 
3052  RDM=V/SA 

3100  IF (TF) 3159 #3200 >3200 


—  x+i 
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3159  IF (VEL) 3101 >3101 #3200 

3101  IF (FS) 3103 >3103 #3102 

3102  FRA=U(L) 

GO  TO  3104 

3103  FRA=(U(L)+UU-+l))/2. 

3104  IF (FRA) 3158 #3150 >3105 
3158  FRA=0. 

GO  TO  3150 

3105  FRA=FRA* ( AMX ( L ) + AMD ( L ) ) / ( T AU ( I ) *D Y ( J ) ) *2 . *P I DY 
1*X(I)*DY(J+1)*DT 

3150  IF ( J+1-JMAX)3152/3151#3152 

3151  FTA=V(L) 

KA=L 

GO  TO  3154 

3152  KA=L+IMAX 

3153  FTA=(V(L)+V(KA))*.5 

3154  IF (FTA)  3155 #3155#  7#157 

3155  FTA=0. 

GO  TO  3156 

3 1 57  FT A=FT A* ( AMX ( L ) * AMD ( L ) ) *DT/D Y ( J  > 

3156  IF(DKE(L) )3166»3200#3166 
3166  GO  TO  3500 

3500  IF { GAMC ( J+l ) +DMASL ( J+l ) ) 3502 » 3501 » 3501 

3501  WS1=AMX(L) 

KS2=AMD(L) 

GO  TO  3503 

3502  WSl=AMX(L)-GAMC(J+i) 

WS2= AMD ( L ) -DM ASL ( J+l ) 

3503  IF ( AMPY+TDM )  350'! » 3162 » 3162 
3162  WS=0. 

WSA=0# 

GO  TO  3505 

3504  WSsAMPY 
WSA=TDM 

3505  IF (FTA) 3700 #3700 #3506 

3506  IF(DKE(L) ) 3900 >3508 >3508 

3900  IFIDKE(L)+1. ) 3507 > 3509 > 3509 

3507  hS-WS-FTA 
GO  TO  3700 

3509  WSA=WSA-FTA 
GO  TO  3700 

3508  IF (OKE (KA) ) 3901 #3901 #3510 

3901  IF (DKE(L) +1*0)3515 #3511 #3511 

3510  FTAX=AMX (KA) / ( AMX (KA) +AMD ( KA) ) *FTA 
FTAD=AM0 ( KA ) / t AMX ( KA ) +AMD ( KA ) ) *FT A 
GO  TO  3520 

3511  FTAD=FTA 

3512  IF ( AMD (L) “FT AD) 3514>3513>3513 

3513  FTAX=0. 

GO  TO  3520 

3514  FTAX=FTAD-AMD(U) 

FTAD=AMD(U 

GO  TO  3520 

3515  FTAX=FTA 

3516  IF ( AMX (L)~FTAX) 3517 >3518 >3518 
3518  FTAO=0. 

GO  TO  3520 


FTAD=FTAX-AMX,(L> 

FTAX=AMX(L) 

GO  TO  3520 
WS=WS**FTAX 

wsa=wsa-ftao 

GO  TO  3700 

IF (FRA) 3800 #3800 #3701 

IF(DKE(L) ) 3902»39Q2»3708 

IF (DKE(L)+1») 3702# 3703# 3703 

WSA=WSA-FRA 

GO  TO  3800 

WS=WS-FRA 

GO  TO  3800 

IF(DKE(L+1) )39Q3#3903#371Q 

IF IDKE (L+l ) +1#)3715# 3711 » 3711 

FTAX=AMX  ( L+l > / ( AMX  (  L+l )  +AMD  (L+l) )  *FR  A 

FTAD=AMD (L+l ) / ( AHX (L+l ) +AMO  <  L+l ) ) *FRA 

WS=WS~FTAX 

WSA=WSA-FTAD 

GO  TO. 3800 

FTAD=FRA 

IF ( AMD ( L+l J-FTAD) 3714 #3713 #3713 
i  FTAX=0. 

GO  TO  3750 
FTAX=FTAD-AMD(L+1> 

FTAD=AMD(L+1) 

GO  TO  3750 
•  FTAX=FRA 

i  IF ( AMX ( L+l )-FTAX) 3719# 3718# 3718 
I  FTA0=0. 

GO  TO  3750 
»  FTAD=FTAX-AMX(L+D 
FTAX=AMX(L+1) 

GO  TO  3750 

I  IF ("WS-WSl) 3802# 3802 #3801 
.  ampy=-ampy/ws*wsi 
»  ip  (-WSA-V/S2)  3200  r  3200 » 3803 
5  TDM=-TDM/WSA*WS2 
)  IF (TR) 4010 » 3024# 3024 
)  WS1=AMX(K+1) 

WS2-AMD(K+1) 

)  IF (J-l) 3999 #4001 #3999 
L  IF ( I-IMAX) 4002 #3024 #4002 

>  FB=V(K+1) 

IF (CVIS) 4004# 4005# 4005 
)  IF ( I-IMAX) 4003 #3024 #4003 
5  KB=K+1-IMAX 
FB=(V(K+1)+V(K8) )*»5 
*.  IF (F3) 4006 #4005# 4005 
5  WS=0* 

WSA=0. 

GO  TO  4100 

>  IF(DKE(K+1) }4030»3024»4007 

7  KB=K+1-IMAX  , ,  „ 

FB=FB*(AMX(K+1)+AMD(K+1)>/DY(J)*DT 

IF(0KE(KB) )4014»4013»40li 
5  KB=K+i 


101 


GO  TO  4011 

4011  FBAX=AMX(K8)/(AMX(KB)+AMD{KB) )*fb 
FBAD=AMD ( KB ) / ( AMX ( KB ) +AMD ( KB ) ) *FB 

4012  WS=WS+FBAX 
WSA-WSA+FBAD 
GO  TO  4100 

4014  IF (DKE( KB) +1*0) 4015, 40 19,4019 

4015  FBAX=FB 

4016  IF ( AMX ( K+l )+F3) 40 18, 4017, 4017 

4017  FBAU=0o 

GO  TO  4012 
4016  FBAX=-AMX(K+1) 

FBAD=AMX(K+1)+FB 
GO  TO  4012 

4019  FBAD=FB 

4020  IF ( AMD (K+l ) +FB ) 4022, 4021 , 4021 

4021  FBAX=0. 

GO  TO  4012 

4022  FBaD=-AMD(K+1) 

F8AX~AMD ( K+l ) +F8 
GO  TO  4012 

4030  FB=F8* ( AMX (K+l ) +AMD ( K+l ) ) /DY ( J) *DT 
IF (DKE(K+1)+1. 0)4032, 4031, 4031 

4032  WSSWS+FB 
GO  TO  4100 

4031  WSA=WSA+FB 

4100  IF (I+l-IMAX) 4102; 4101 »4102 

4101  FRR=U(K+1) 

GO  TO  4103 

4102  FRR=(U(K+l)+U(K+2) )*.5 

4103  IF (FRR) 4200 ,4200. 4104 

4104  IF (DKE(K+1) ) 4130 ; 4200 , 4105 

4130  FRR=FRR* ( AMX ( K+l ) +AMD ( K+l ) ) / ( TAU ( I ) *DY ( J ) ) *2 . 0*P loY 
i*X(I+l)*DT 

4140  IF (DKE(K+1)+1. 0)4141, 4142, 4142 

4141  WS=WS-FRR 
GO  TO  4200 

4142  WSA-WSA-FRR 
GO  TO  4200 

4105  KR=K+2 

4106  FRRcFRR* ( AMX  ( K+l )  +AMD  (K+l) )  /  (TAU  (I)*DY(J)  )*2»  0*PIDY* 
1X( 1+1) *DT 

4107  IF (DKE(KR)  )41l0«’4lQ9,4108 
4109  KR=K+1 

GO  TO  4108 

4108  FBAX=AMX ( KR ) / ( AMX ( KR ) + AMD  J  KR ) ) *FRR 
FB AD=AMD ( KR ) / ( AMX ( KR ) + AMD (KR) ) *FRR 

4150  WS=V/S-FBAX 
WSA=WSA-FBAO 
GO  TO  4200 

4H0  IF (DKE (KR)+lo 0)4112, 4111  »4111 
4111  FBAD=FRR 

4116  IF (AMD (K+l) -FRR) 4118,4117,4117 

4117  F8AX=0. 

GO  TO  4150 

4118  FBAO=AMD(K+l) 

FcAX=FRR-AMD(K+l) 
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4112 

4113 

4114 

4115 


4200 

4201 

4202 

4203 

4204 

4205 

4206 

4207 

4208 
4212 

4209 

4210 

1  4211 

4220 
•  4221 

4222 

4250 


4230 

4224 

4225 

4226 

4227 


4223 

4228 

4229 

4231 


4.500 

4301 

4302 

4303 
3024 


GO  T0  4150 
FBAXsFRR 

IF(AiMX(K+1)-FRR)4.U5»4114»4114 

FBAD=0. 

GO  TO  4150 
FBAX=AMX(K+1) 

FBAO=FRR~AMX(K+l> 

GO  TO  4150 

IF(VEL) 4203» 4203 >4201 
IF (FS) 4202 >4202* 4300 
FAB=V(K+1) 

GO  TO  4206 

IF  (FS)  4204 1 4204  »4">00 

KA=K+1+IMAX 

FAB-(V (KA)+V(K+1) )  *.5 

IF (FAB) 4300 » 4300 » 4207 

FAB=FAB*(AMX(K+1)  v AMD (K+l) )/DY (J)*DT 

IF(DKE(K+I))4209>':300f4212 

KA=K+1+IMAX 

GO  TO  4220 

IF(DKE(K+1) +1  #  0)4^10 » 4211  »4211 

V,'S=v/S“FA8 

GO  TO  4300 

lvSA=WSA~FAB 

GO  TO  4300 

IF (DKE(KA)  )423Q»4 22i»4222 

KA=K+1 

t»0  TO  4222 

F8 AX= AMX ( KA ) / ( AMX < KA ) + AMD ( K A ) ) *FAB 

F  8 AO=AMO ( KA ) / ( AMX i KA ) +AMD ( KA ) ) *FAB 

WS=WS-FQAX 

WSA=WSA-FBA0 

GO  TO  4300 

IF ( DKE ( KA ) +1 o  0 ) 4224 » 4223 1 4223 
F6AX=FAB 

IF ( AMX ( K+l ) -FAB  >  4227 » 4226 1 4226 
FBAD=Q. 

GO  TO  4250 
FBAX=AMX(K+1) 

F8AD=FAB-AMX(K+1> 

GO  TO  4250 

F8A0=FAB  ,  „ 

IF ( AMD ( K+l ) -FAB ) 4231 » 4229 » 4229 

FBAX=0, 

GO  TO  4250 
FBAD=AMD(K+1) 

F8AX=FAB-AMD(K+i) 

GO  TO  4250 

IF (-WS-WS1) 4302 *  4302 >4301 
AMMP=-AMMP/WS*WS1 

IF (~WSA-rtS2) 3024*4303 >4303 
P.0M=“RDM/  Yi  5  A*  YJS2 
CONTINUE 


C 

t 

C 

C 


FINIS  OF  ELABORATE  LOOK  AHEAD. 

CHECK  POSSIBLE  OPTIONS  TO  LIMIT  THE 
MAGNITUDE  OF  THE  FLUXES 


1C3 


5b OU  IF(AMPY)  5504*5603*5501 
5b0l  IF(VEL)  5502*5502*5600 
02  WS-  f AU  ( I )  *DY  ( J+i ) 

IF (AMPY/WS  -  2(144))  5503*5503*5600 
5b03  AMPY=0, 

GO  TO  5600 
5504  WS=TAU(I)*QYtJ> 

IF(”AMPY/WS  -  ZU44J)  5503*5503*5600 

5600  IF (TOM)  5604*5700*5601 

5601  IF  (VEL)  5602*5602*5700 

5602  WS=TAU(I)*DY(J+1) 

IF(TDM/WS  -  2(143))  5603*5603*5700 
5b03  TDM-O# 

GO  TO  5700 
5604  WS=TAU(I)*OY(J) 

IF {"TPM/WS  -  2(143))  5603* 5603* 5700 

5700  IF(AMMP)  5704*5800,5701 

5701  IF(FS) 5702*5702*5800 

5702  WS=TAU(I+1)*DY(0) 

IF (AMMP/WS-Z1144) )  5703*5703*5800 

5703  AMMP=0. 

GO  TO  5800 

5704  WS=TAU(I)*OY(J) 

IF(-AMMP/WS~Z(144) )  5703*5703*5800 

5800  IF(RDM)  5804*5900*5801 

5801  IF(F5)5802, 5802*5900 

5802  WS=TAU(I)*DY(J> 

IF(R0M/WS-Z(143) )  5803*5803*5900 

5803  RDM=0. 

60  TO  5900 

5804  WS=TAU(I)*OY(J) 

IF (“RDM/WS  -  Z ( 143) )  5803,5803*5900 
5900  CONTINUE 

900  IF (AMP Y)  901*920*920 

901  IFfGAMC ( J+l) )  903*902*902 

903  WS=AMX(L)+GAMC(vJ+l) 

904  IF (WS  +  AMPY)  905*920*920 

905  AMPY  =-WS 
GO  TO  920 

902  *S=AMX(L) 

GO  TO  904 

920  IF(TDM)  921*930*930 

921  IF(DMASUJ+i))  923*922*922 

923  wS=AMO(L)+DMASL(J+1> 

924  IF(wS+TDM)  925*930*930 

925  ’rDMs-WS 
GO  TO  930 

922  WS~AMO(L) ' 

GO  TO  924 

930  IF(AMMP)  931*940*940 

931  IF(AMX(K+1)  +  AMMP)  932*940*940 

932  AMMPs-AMX(K+l) 

940  IF (RDM)  941*954*954 

941  IF CAMD(K+1)  +  RDM)  942*954,954 

942  KOMS-AMD(K+l) 

954  CONTINUE 

74  JTAG=0 


PH2  2260 


o  o 


T 
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309  IF (AMPY+TOM) 8834 f 3831 t 8833 

8833  IF (UMAX-J)  9911 » 3!<3r  8835 
.  8835  KP.-K+IMAX 

8836  IF(AMX(KP)+AMD(Kf*) )  9900  f  8837  f  318 
C  RULES  FOR  TOP  FR’ E  SURFACE  WITHIN  THE  GRID 
:  8837  IF ( (AMPY+TDM)/\TAU(I)*DY (J) ) -TOZONE) 8838 » 318 » 318 

8838  AMPY=0.0 
TDM=0, 

GO  TO  8831 

8834  IF ( J-l ) 9911 , 325 >0339 

8839  IF(AMX(K)+AMD(K> ) 9900  *  8840 > 325 

C  RULt-S  FOR  BOTTOM  FREE  SURFACE  WITHIN  THE  GRID 

8840  IF( (~AMPY-TDM)/(TAU(I)*DY (J+l) )-T0Z0NE)8841»325>325 
e841  AMPY=0,Q 

TDM=0. 

GO  TO  8831 

318  DELM=GAMC(J)+AMMY-AMPY 

delmd=dmasl  ( u )  +bc  m-tdm 

322  IF (VEL)9901r324»323 

323  WS=U(K) **2+V (K) **2 
ETH=ETH-AMPY* ( A IX I K ) +WS/2 . 0 ) 

ETH=ETH-TDM* (AID  (.0  +WS/2 . ) 

C  A  TRANSMITTIVE  SURFACE  AT  TOP  GRID  BOUNDARY t 

‘C  CHECK  FOR  SUFFIC'INT  MASS  TO  TRIGGER  REZONE. 

IF  ( ( AMPY+TOM )  /  ( T,VJ  (I)*DY(J) )  -TOZONE)  324 » 324 1 6900 
69G'  REZ=1.0 

•C  CALCULATE  THE  MO.VINTUM  OF  THESE  TOP  FLUXES 

324  AMUT=AMPY*U(K) 

AMVT=AMPY*V(K> 

TDXM=TOM*U(K) 

TDYM=TDM*V(K) 

GO  TO  326 

325  CONTINUE 

C  CALCULATE  THE  MOMENTUM  OF  THESE  TOP  FLUXES 
8831  AMUT=AMPY*U(L) 

AMVT=AMPY*V(L) 

TDXM=TDM*U(L) 

TOYM=TDM*V(L) 

C  OELM  =  MASS  AT  LEFT  +  BOTTOM  -  TOP  FOR  X  MATERIAL 
DELMrGAMC ( J) -AMP  f+AMMY 

C  DELMD  =  SIMILAR  FUNCTION  FOR  DOT  MATERIAL 
OELMD=DMASL ( J ) +BOM-TDM 

326  IF ( AMPY) 327 >  328*328 

327  uELET=AIX<U  +  (U(L)**2+V(L)**2)/2.0 
GO  TO  333 

320  I F ( AMMY ) 329  *  330 1 330 

329  uELET=DELEB 
GO  TO  333 

330  IF (GAMC (U) ) 331 * 332» 332 

331  OELET=SIGC(U) 

GO  TO  333 

NOW  WE  HAVE  SPECIFIC  ENERGY  CARRIED  BY 
THE  X  FLUX. 

332  uELt.T=AIX(K)  +  (U(K)**2+V(K>**2)/2.0 

333  IF ( TuM) 8310  >  8011  * 8811 
8810  TUTE=AlD(L)  +  (U(L)*->-2+V(L)**2)/2. 

GO  TO  8817 


PH2  3400 
PH2  3410 


PH2  3440 

PH2  3450 
PH2  3460 


PH2  3490 

PH2  3500 
PH2  3510 

PH2  3520 
PH2  3530 
PH2  3540 


PH2  3560 

PH2  3570 
PH2  3580 


PH2  3590 
PH2  3600 

PH2  3610 
PH2  3620 


PH2  3630 


PH2  3640 
PH2  3650 
PH2  3660 
PH2  36/0 
PH2  3680 
PH2  3690 
PH2  3700 
PH2  3710 
PH2  3720 


PH2  3730 


o  o  o  o  o  o 


8811  IF (BDM) 8812/ 8813/ 0813 
3812  T0TE=8DTE 
«  60  TO  8817 

rjl3  IFIDMASL(U) ) 8814/8315/8815 
0314  TDTE=DENRG(J) 

GO  TO  8817 

C  NOW  WE  HAVE  SPECIFIC  ENERGY  CARRIED  BY 
C  THE  DOT  FLUX 

TfllS  TOTEnAlD(K) +(U(K) :'*2+V(K)** 2)/2. 

SUM  UP  EACH  COMPONENT  OF  MOMENTUM 

FOR  EACH  MATERIAL/  EXCEPT  THE  RIGHT  FLUX 

AND  MOMENTA  OF  CELL  IN  QUESTION. 

8817  SIGMU=FLEFT (U)  +AMI AJ-AMUT 
sigmud=dxml(U)+bq:;m-tdxm 

SIGMV=YAMC(J)+AMM7-AMVT  PH2  3750 

S I GMVD=DYML ( U ) +BD7M-TDYM 

SUM  UP  THE  CHANGE  IN  ENERGY  (BOTH  X 

AND  .)  FOR  THE  CEIL  IN  QUESTION  EXCEPT 

FOR  ENERGY  AT  THE  RIGHT  AND  ENERGY  OF  THE 

CELL  IN  QUESTION. 

OELEK=GAMC ( J ) *S I GO ( J ) +AMMY *DELE8“AMP Y *DELET  PH2  3760 

C*-LED=DMASL  ( J )  *0E:  RG  ( J )  +80M+BDTE 
1-TDM*TDTE 

'  509  IF  (AMMP+RDM)  8843 /’' 18/8844 

8844  IF (IMAX-I) 9911/51'/ 8845  PH2  3780 

8845  IF(AMX(K+1) *AMD(K’ 1) ) 9900/ 8846/ 518 

C  RULES  FOR  FREE  SU.  FACE  AT  THE  RIGHT  WITHIN 

C  THE  GRID. 

8846  IF l ( AMMP+RDM) / (TA> « ( I ) *DY ( J) ) -TOZONE) 8847/518 z 518 

8847  AMMPsO.O  PH2  3810 

R0M=0 . 

GO  TO  518  .  PH2  3820 

8843  IF  ( 1-1)9911/ 512/8"' 48  PH2  3830 

8848  IF (AMX(K)+AMO(K) )‘  900/8849/512 

C  RULES  FOR  FREE  SU.  FACE  AT  THE  LEFT  WITHIN 

C  THE  GRID. 

8b49  IF ( l-AMMP-RDM) / (TAU( 1+1) *DY ( J) ) -TOZONE) 8850/ 512/512 
8850  AMMP=0.0 
RDM=0 . 

GO  TO  518 

C  NOW  UELM  =  CHANGE  IN  X  MASS  FOR  CELL  K 

512  DELM=DELM-AMMP+AMX(K) 

C  NOW  OELMD  =  CHANGE  IN  .  MASS  FOR  CELL  K 

DELMO=DELMO-RDM+ AMD ( K ) 

513  CONTINUE 

514  CONTINUE 

C  CALCULATE  THE  MOMENTUM  OF  THE  RIGHT  FLUXES 
8828  AMUR=AMMP*U(K+1> 

RQXM=RDM*U(K+1) 

AMVR=AMMP*V(K+1) 

RDYM-RDM*V(K+1) 

GO  TO  525 

C  NOW  OELM  =  CHANGE  IN  X  MASS  FOR  CELL  K 
510  DELM=DELM-AMMP+AMX(K) 

C  NOw  DELMD  =  CHANGE  IN  .  MASS  FOR  CELL  K 
0ELMD=DELMD-RDM+AMD(K> 

521  CONTINUE 


PH2  3860 
PH2  3870 
PH2  3880 

PH2  3890 
PH2  3900 

PH2  3910 

PH2  3920 

PH2  3930 

PH2  3940 

PH2  3950 


o  o 


522  IF(FS) 9905 » 524 r 523 

523  WS=U(K)**2+V(K)**2 

.  ETH=ETH-AMMP*(AIX.(K)+WS/2.Q) 

ETH=ETH-RDM* ( A ID ( X ) +WS/2 . 0 ) 

C  A  TRANSMITTIVE  SURFACE  AT  RIGHT  GRID  BOUNDARY t 

S  CHECK  FOR  SUFFICIENT  MASS  TO  TRIGGER  REZONE. 

IF l ( AMMP+RDM) / (TAU (I)*DY (J) ) -TOZONE) 524 i 524 » 6901 
6901  REZ=1.0 

524  AMUR=AMMP*U(K) 

ROXM=RDM*U(K) 

AMVR=AMMP*V(K) 

RDYM=RDM*V(K> 

C  MOW  SUM  THE  NET  MOMENTA  CHANGES 
C  BY  THESE  FLUXES 
C 

525  SIGMU=SIGMU-AMUR 

S I GMUD=S I GMUD-RDXM 
SIGMV=SIGMV-AMVR 

sigmvd=sigmvd-rdym 

526  TIC=0.0 

527  IF (AMMP) 528»  529»  529 

528  DELER=AIX (K+l ) + ( U ( K+l ) **2+V (K+l ) **2 ) /2. 0 
GO  TO  537 

;  529  IF(AMMY)530»531»531 
530  DELER=DELEB 
GO  TO  536 

•  531  IF(GAMC(J) ) 532 #533.533 

532  DELER=SIGC(J) 

GO  TO  536 

533  IF (AMPY)535»535»534 

534  OELER=DELET 
GO  TO  536 

C  NOW  WE  HAVE  THE  SPECIFIC  ENERGY  FOR  FLUX 
C  AT  THE  RIGHT  FOR  X  MATERIAL 

535  OELER=A I X ( K ) + ( U ( K ) **2+V (K)**2)/2.0 

536  TIC=1.0 

NOW  WE  HAVE  TOTAL  CHANGE  IN  ENERGY  BY 
THE  4  FLUXES  FOR  X  MATERIAL 

537  DELEK=DELEK-AMMP*DELER 
999  IF (RDM) 700 » 701 » 701 

700  RDTE=AID(K+l)+(U(K+l)**2+V(K+l)**2)/2. 

GO  TO  710 

701  IF (BDM) 702.703 *703 

702  RDTE=BDTE 
GO  TO  710 

703  IF (DMASL( J) )704»705*7Q5 

704  RDT£=OENRG(J) 

GO  TO  710  • 

705  IF ( TDM) 706 » 706 » 707 
707  RDTE=TDTE 

GO  TO  710 

*C  NOW»  THE  SPECIFIC  ENERGY  FOR  THE  FLUX 
C  AT  The  RIGHT  FOR  DOT  MATERIAL. 

706  RDTE=<U(K)**2+V(K)**2)/2,+AID(K) 

t  NOW  WE  HAVE  TOTAL  CHANGE  IN  ENERGY 

c  by  the  4  fluxes  for  dot  material. 

710  oELEO=OElEd-RDM*RDTE 


PH2  3960 
PH2  3970 
PH2  3980 


PH2  4000 
PH2  4010 

PH2  4020 


PH2  4030 

PH2  4040 

PH2  4050 
PH2  4060 
PH2  4070 
PH2  4080 
PH2  4090 
PH2  4100 
PH2  4110 
PH2  4120 
PH2  4130 
PH2  4140 
PH2  4150 
PH2  4160 
PH2  4170 


PH2  4180 
PH2  4190 


PH2  4200 
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* 

539  WS=(U(K)**2+V(K)**2)/2.0 
IF (DELM) 998*712 >712 

>  998  IF (AMX(K)*1 .E-6+0ELM) 9906*997*997 

997  OELM=0. 

712  IF(DELMD)7l3*714>714 
'  713  IF(AMD(K)*l»E-6+DELMD)9906*7l5*715 

715  DELMD=0. 

714  CONTINUE 

540  £NK=AMX(K)*(WS+AIX(K) )+0ELEK 
DENK=AMD (K)*(WS+AID(K) )  +DELED 

wsa=delm+delmd 

IF (WSA) 543 >543 >541 
C 

C  CONSERVE  MOMENTUM  TO  CALCULATE  THE 

C  RADIAL  VELOCITY  COMPONENT 

C 

b41  U ( K ) = ( S IGMU+S I6MU0+ (AMX(K) +AMD (K) )*U(K) ) /WSA 
IF (ABS(U(K) )  -2(146))  9951*9951*601 
9951  ETH1=ETH1+(DELM+DELMD)/2.*(U(K)**2> 

U(K)=0. 

C 

C  CONSERVE  MOMENTUM  TO  CALCULATE  THE 

C  AXIAL  VELOCITY  COMPONENT. 

:C 

601  V(K)-( S IGMV+S I GMVD+ (AMX(K) +AMD ( K ) ) * V ( K ) ) /WSA 
IF (ABS(V (K) >"Z(146) )  9952*9952*9953 
•  9952  ETHl=ETHl+(DELM+DELMD)/2o+(V(K)**2> 

VlK)=0. 

C  CHECK  FOR  ADVANCING  ACTIVE  GRID  COUNTER 

C  IN  THE  RADIAL  DIRECTION. 

9953  IF ( 1-11)603*6604*6604 


6604  IF(U(K) >6605*6606*6605  PH2  4330 

6605  NRC-1  PH2  4340 

6606  IF ( V (K) ) 6607*6608*6607  PH2  4350 

6607  NRC~1  PH2  4360 

6608  IF (AIX(K)+AID(K)) 6609* 6610 *6609 

6609  NRC=1  PH2  4380 

6610  CONTINUE  PH2  4390 

603  WS=U(K)**2+V(K)**2  PH2  4400 


542  CONTINUE 

IF ( DELM+OELMD ) 543  *  543  *  750 

750  IF (DELM)75l*751*752 

751  AlD(K)=DENK/DELMD-WS/2. 
uKE(K)=-l. 

GO  TO  543 

752  IF (DELMD) 753*  753*  754 

753  AIX(K)=ENK/DELM-WS/2. 

DKE(K)=-2i 

GO  TO  543 

754  CONTINUE 
C 

*'C  THE  NEW  INTERNAL  ENERGY  IS  THE  TOTAL 
C  LESS  THE  KINETIC 
C 

OQ=ENK+DENK- . 5*WS* ( DELM+OELMD ) 
v<S=  ENK  +DENK 


oo  oooo  oooo 
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C  CALCULATE  THE  NEW  SPECIFIC  INTERNAL  ENERGIES 

C  FOR  EACH  MATERIAL 

-C 

AIX(K)=ENK/DELM/WS*DQ 
A ID ( K ) =DENK/DELMD/WS*DQ 
DKE(K>=1. 

5^3  AMX(K)=0ELM  PH2  4420 

AMD(K)=DELMD 

IF( AMXCK) +AMDIK) ) 9900 » 2007 #725 
2007  AIX(K)=0. 

AID(K)=0. 

DKE(K)=0. 

U(K)=0. 

V(K)=0. 

P(K)=0. 

GO  TO  544 

725  IF ( Amy ( |0  ) 9900 » 716 , 717 

716  AIX(K)=0. 

DKE(K)=-1. 

GO  TO  544 

717  IF(AMD(K))9900»718»719 

718  AID(K)=0. 

DKE(K)=-2. 

GO  TO  544 

719  CONTINUE 

SET  THE  LEFT  QUANTITIES  WITH  THOSE  FROM  THE 
RIGHT  FOR  THE  NEXT  COLUMN  SWEEP. 

544  GAMC(J)=AMMP 
FLEFTCJ)=AMUR 
YAMC(J)=AMVR 
SIGC(J)=DELER 
DMASL(J)=RDM 
DXML( J)«RDXM 
DYML(J)=RDYM 
DENRG(J)=RDTE 

SET  THE  BOTTOM  QUANTITIES  WITH  THOSE 
FROM  THE  TOP  FOR  THE  NEXT  CELL  ABOVE 

545  AMMY=AMPY 
AMMU=AMUT 
AMMV=AMVT 
OELEB=DELET 
6DM=TDM 
BDXM=TDXM 
BDYM=TDYM‘ 

BDTE=TDTE 


546  K=K+IMAX  PH2  4560 

LL=K-IMAX  PH2  4570 

CHECK  FOR  ADVANCING  THE  ACTIVE  GRIO  IN  THE 
AXIAL  DIRECTION. 

IF(U(LL) )6500»6600»650Q  PH2  4580 

'  6500  NRT=1  PH2  4590 

6600  IF ( V (LL) )660l»6602»6601  PH2  4600 

6601  NRT=1  PH2  4610 


PH2  4480 
PH2  4490 
PH2  4500 
PH2  4510 


PH2  4520 
PH2  4530 
PH2  4540 
PH2  4550 


*] 


6602  IF (AIX(LL) +AlO(LL) ) 6611 » 547* 6611 
66U  NRT=1 
547  CONTINUE 

AOVANCE  ACTIVE  GRID  COUNTERS 

Xi=Il+NRC 

X2=I2+NRT 

IF (IMAX-I1) 6700 >6701,6702 

6700  IjUIMAX 

6701  CONTINUE 

6702  IF ( JMAX-I2) 6800  * 6801 » 6802 

6800  I2=JMAX 

6801  CONTINUE 

6802  GO  TO  548 
9901  NK=300 

GO  TO  9999 
9900  NK=302 

GO  TO  9999 

9903  NK=305 

GO  TO  9999 

9904  NK=506 

GO  TO  9999 

9905  NK=500 

GO  TO  9999 

9906  NK=998 

AND  STATEMENT  NO.  713  ALSO 
GO  TO  9999 
9911  NK=8833 

GO  TO  9999 

9908  NK=  17 

GO  TO  9999 

9909  NK=  22 

GO  TO  9999 

9910  NK=  47 

GO  TO  9999 

9907  NK-538 
9999  NR=4 


PH2  4630 
PH2  4640 

PH2  4650 
PH2  4660 
PH2  4670 
PH2  4680 
PH2  4690 
PH2  4700 
PH2  4710 
PH2  4720 
PH2  4730 
PH2  4740 
PH2  4750 
PH2  4760 
PH2  4770 
PH2  4780 
PH2  4790 
PH2  4800 
PH2  4810 
PH2  4820 
PH2  4830 


PH2  4850 
PH2  4860 
PH2  4870 
PH2  4880 
PH2  4890 
PH2  4900 
PH2  4910 
PH2  4920 
PH2  4930 
PH2  4940 
PH2  4950 


WRITE (6» 9939) I *U?K»L*N» Il» I2*NK*NR 

WRITE (6*9938) AMPY » AMUT  »  AMVT * DELET  * AMMP * AMUR , AMVR *  dELER 

WRITE ( 6 , 9938 ) AMMY » AMMU  r  AMMV * DELEB  * GAMC ( J )  * FLEFT ( J )  *  YAMC ( J ) *  S I GC ( J ) 

WRITE ( 6 » 9938  >  TDM  *  TDXM * TDYM * TOTE * RDM  * RDXM *  RDYM r  ROTE 

WR ITE ( 6 » 9938 )  BOM  r  BDXM * BDYM *  BOTE  *  OMASL  ( J )  *DXML(J)  *DYML(U)  *DENRG(J) 


WRITE (6* 9939) NX *ND 

WR I TE ( 6 * 9938 ) DELM  * DELMD * S I GMU * S I GMUD *SIGMV*SI GM VD  *  DELEK * DELED  * 
WRITE ( 6*9938) AMX(K) »AIX(K) »U(K) *V(K) * AMD ( K ) »AID(K) *P(K) 

WRITE (6*9938) AMX(L) *AIX(L) *U(L) rV(L) rAMD(L) *AID(L) f P  CL) 


9939  FORMAT (916) 

9938  FORMAT (1P8E12. 5) 
CALL  DUMP • 

548  SUM=Q.Q 
2005  DO  2001  1=1 f II 
K=I+1 

DO  2013  J=1»I2 


•PH2  4960 
PH2  4970 
PH2  4980 
PH2  4990 


WSA~0 • 

WS=TAU(I)*DY(J) 

IF (AMX(K) ) 5952*5952*5950 
C  OPTION  FOR  REMOVING  LOW  DENSITY  X  MASS 
5950  IF ( AMX ( K ) /WS -Z ( 107) ) 5951 * 5951 * 5952 
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5951  WSA=(U(K)**2+V(K)**2)/2. 
Z(1Q0)=Z(100)+AMX(K) 
WSA-AMX (K)*(AIX(K)+WSA) 
SUM=SUM+WSA 
Z(101)=Z(101)-WSA 


AMX(K)=0. 


AIXiK)=0o 

5952  IF(AMD(K) ) 5960 #5960 #5963 
C  OPTION  FOR  REMOVING  LOW  DENSITY  .  MASS 
5963  IF l AMD (K) /WS"Z { 103) ) 5962 » 5962 » 5960 
5962  WSA=(U(K)**2+V(K>**2)/2. 
Z(100)=Z(100)+AMD(K) 

WSA=AMO ( K )  *  ( A  ID  ( K ) +WSA ) 

SUM-SUM+WSA 

z(ioi)=zaoi)-wsA 


AMD(K)=0* 

AID(K)=0. 

5960  IF(AMD(K)+AMX(K) )  !5961#  5961 » 2008 

5961  U(K)=Q. 

V(K)=0. 

P(K)=0. 

DKE(K)=0. 

GO  TO  2013 

:C  OPTION  FOR  REMOVING  SMALL  (OR  NEGATIVE) 
C  INTERNAL  ENERGIES  FOR  MATERIAL  (X) 

2oQ8  IF (AIX (K)  -Z(145))  2004»2011»2011 
•  2004  SUM=SUM+AlX(K)*Ai>‘<(K) 


C  OPTION  FOR  REMOVING  SMALL  (OR  NEGATIVE) 

C  INTERNAL  ENERGIES  FOR  MATERIAL  (DOT) 

2011  IF(AID(K)-Z(145) )2012»2000»2000 

2012  sum=sum+aid(K)*a::o(K) 

AID(K)=0. 

2000  IF(AMX(K)+AMD(K) )4400»4400»440l 

4401  IF(AMX(K) ) 4402 » 4402 » 4403 

4402  DKE(K)=-1. 

GO  TO  2013 

4403  IF (AMD(K) )2009»2C09»2010 

2009  DKE(K)=-2. 

GO  TO  2013 

2010  DKE(K)=1. 

GO  TO  2013 

4400  DKE(K)=0. 

2013  K=K+IMAX 

2001  CONTINUE 
eth=eth-sum-ethi 

Z(104)=Z(104)+SUM 

C  CHECK  IF  REZONE  FLAG  HAS  BEEN  SET  BY  PH2 


8000  IF(REZ) 8001 » 6001 » 8002 
:  CHECK  IF  YOU  WANT  TO  CALL  REZONE 

8002  1F(REZFCT)8004»8004»8003 


*  8004  REZ=0. 

GO  TO  8001 
8003  CALL  REZONE 
**  8001  RETURN 
ENO 


PH2  5170 
PH2  5180 


PH2  5200 
PH2  5220 


•PH2  5260 


C 


o  o  o 
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C 

-  SUBROUTINE  ES 

C 

c 

*.  200  IF ( AMX (K) ) 9901*201 >202 
C  DOT  MATERIAL  ONLY 

201  6EL=«1. 

WS3=1. 

WSA=i. 

210  WS1=AMD(K) 

V/S2=AlD(K) 

JJ=116 

DO  701  11=1*10 
PRIII)=Z<JJ) 

JJ=JJ+2 
701  CONTINUE 
•GO  TO  10 

202  IF { AMD (K) ) 9901*203*204 

C  X  MATERIAL  ONLY 

203  BEL=-1.  . 

WSA=1. 

.  WS3=-1 • 

*  211  CONTINUE 

rtSl=AMX<K) 

WS2=rtIX(K* 

•C  HERE  SET  Z  BLOCK  DATA  FOR  (X)  MATERIAL  TO  PR  BLOCK 

Ud=ll5 

00  700  11=1*10 
PR(II)=Z(JJ) 

JJ=JJ+2 
700  CONTINUE 
GO  To  10 
MIXED  CELL 
Z(U5)=RH0N0T  FOR  X 
Z(il6)=RH0N0T  FOR  (.) 

204  EPS!-. 5 
WSA=EPSI 
WS3=-1» 

BEL=i* 

NN=0 

GO  TO  211 

10  CONTINUE 

RHOW=WSi/ ( TAU ( I ) *DY ( J ) ) 

RHOW=RHOW/WSA 
ETA=RHOW/PR(l) 

V0V<=1»  0/ETA 

11  Pl=rfS2*RH0W*PR(2) 

12  P2=WS2 
P3=ETA*ETA*PR(3> 

14  P4=PR(4)/(P2/P3+1.)*WS2*RH0W 

15  P5=PR(5)*(ETA-1«) 

16  IF (ETA-1. ) 50 » 100 *100 
50  IF (VOW-PR( 6)) 55*55*75 
55  IF  (V<52-PR(7) ) 100*100*75 
75  P7=PR(8)*(V0W-1») 

IF (P7-88. ) 4002*4002*4003 
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4o03 

4002 


4001 

4000 


-  9901 


P7='id.0 

CONTINUE 

P8=EXP(P7) 

P9=l./P8 

P1Q=PR(9)*( (VOW-1. )**2> 

IF (P10-88.) 4000 > 4000 t 4001 
P1G=68, 

CONTINUE 

PU=EXP(P10) 

P12=1./P11 

WSC=P1+(P4+P5*P9)*P12 
GO  TO  120 

P6=PR(10)*(  (ETA“.U)**2) 

VjSC=P1+P4+P5+P6 

continue 

IF ( WbC ) 999 1 999  #500 
WSC=0. 

WSGX=.5 

IF(oEL)501»502p502 
CELL  IS  NOT  MIXED 
P(K)=V/SC 
GO  TO  600 

IFUS3)503»509»509 
V<S3=l  ♦ 

WSA=1»~WSA 
P(K)=WSC 
EPSI=1.-WSA 
GO  TO  210 

N1  =  MAX*  NOo  OF  CYCLES  FOR  ITERATION 
i  IF (N1**NN) 420 #  13» li 
i  NN=NN+1 

IF { P  <  K) ) 510 » 510 >511 
I  P(K)=0. 

GO  TO  400 

.  WS1=ABS(P(K)-WSC) 

IF (WS1/A8S (P (K) ) "• 05) 420  #420 » 410 
)  IF(P(K)-WSC)40Q»t!20»401 
)  P(K)=(P(K)+WSC)/2. 

UKE(K)=EPSI 
GO  TO  600 

FEF  =  EPSILON  TO  INCREASE  OR  DECREASE  PARTIAL 
VOLUMES  FOR  THE  ITERATION 
L  EPS1=EPSI+FEF 

IF (EPSI- *99)710 *710 #711 

1  EPSU.99 
0  WSA=EPSI 

WS3=-1. 

GO  TO  211- 
0  EPSI=EPSI-FEF 

IF (EPSI-*01)712»712#713 

2  EPSI=.01 

3  WSA=EPSI 
WS3=-1. 

GO  TO  211 

1  NK=200 
NR=9999 
CALL  DUMP 


cnr> 
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600  WSGX=*5 
RETURN 
END 


SUBROUTINE  EDIT 
C 

c  EDIT 

100  IF(SWITCH)102*104?102 
102  CALL  SSWTCH(4*K000FX) 

GO  T0(l22*104) *KG00FX 

C  FIRST  CYCLE  OF  THE  RUN  (SENSE  LIGHT  3  ON) 

104  CALL  SLITET(3*K000FX) 

GO  T0(106*108) rKOOOFX 
106  CALL  SLITE  (3) 

GO  TO  126 

108  IF (CYCLE-CSTOP) 11A / 122*122 

110  IF (REZ) 9901  *  112* 1R4 

112  IF (AMOD (CYCLE »DUiV.!‘T7) )  114*124*114 

114  IF(AH0D(CYCLE»PRINTL) ) 116*126*116 

116  IF (SWITCH) 118*120 ? 118 

118  CALL  SSWTCH(5*KOOOFX) 

GO  T0(l28*120)  *K000FX 
120  IF(AMOD(CYCL£*PRl:iTS))140»128*140 
C  NORMAL  OR  FORCED  STOP  ON  THIS  CYCLE 

•  122  CALL  SLITE  (1) 

C  EXECUTE  WTAPE  -  DUMP  VARIABLES  ONTO  TAPE  7 

124  GO  TO  1 

C  SET  SENSE  LIGHT  TO  INDICATE  TAKING  OF  LONG  PRINT 

126  CALL  SLITE  (4) 

C  EXECUTE  SP  -  WRITE  THE  SHORT  PRINT  INFORMATION 

128  GO  TO  6000 

C  EXECUTE  PLOT  -  PLOT  THE  FILLED  CELL  DISTRIBUTION 

130  GO  TO  1000 
132  CALL  SLITET(4*KOOOFX) 

GO  T0(134»136) *KQ0QFX 

C  EXECUTE  LP  -  WRITE  THE  LONG  PRINT  INFORMATION 

134  GO  TO  5000 

C  TEST  FOR  AN  ENERGY  CHECK  VIOLATION 

136  1F(A8S(ECK)-DMIN) 140*140*9905 
140  CALL  SLITETU'KOUOFX) 

GO  T0(142* 144) *K000FX 
142  REWIND  N7 

CALL  SLITE  (1) 

144  GO  TO  10000 
G 
C 

SUBROUTINE  wTAPE  *************+**£.-^*****fc************ ****##«. 

1  IF(DUMPT7) 30»3*3 
3  BACKSPACE  N7 
WS=555.Q 

WRITE ( N7 ) WS  *  CYCLE  *  N3 
WRITE(N7) (Z(L) *L=1*M2) 

6  WRITE  (N7)  (UU)*V(X),AMD(I)  >AMX(I) » AIO(I)  *AIX(I) » 

1PC;  *CKE(I)  »1=1»KMAXA) 


EDIT0050 

EDIT1010 

EDIT1130 

EDIT1140 

EDIT1150 

EDIT1160 

EDIT1170 

EDIT1180 

EDIT1190 

EDIT1200 

EDIT1210 

EDIT1220 

EDIT1230 

EDIT1240 

EDXT1250 

EDIT1260 

EDIT1270 

EDIT1280 

EDIT1290 

EDIT1300 

EDIT1310 

EDIT1320 

EDIT1330 

EDITI340 

EDIT1350 

EDIT1360 

EDIT1370 

EDIT1380 

EDIT1410 

EDIT1420 

EDIT1430 

EDIT1440 

EDIT1450 

EDIT1460 

EDIT1470 

EDIT148Q 

EDIT1490 


EDITJ.510 
ED IT 1520 
EDIT1530 
EDIT1540 
i-.****EDIT1550 
EDIT1580 

EDIT1620 


;  30 

C  **** 
C 
C 

c 

6000 


WRITE(N7) (X(K) »TAU(K) »K=1»IMAX) 

WRITE (N7) (Y(K) *K=1» JMAX) 

WS-666 . 0  EDIT1780 

WRITE (N7)WS»WS»WS 

WRITE  (6»8120)NC  EDIT1800 

GO  TO  126  EDIT1810 

END  OF  WTAPE  SUBROUTINE  aMt:M«**************#**^**************#***EDXT1820 

EDIT1830 

EDIT1840 

SUBROUTINE  S  P  **s*********#*-***********#*********************:it***EDIT1850 


6ol0 

6012 


6ol4 


6ol5 

6017 

6018 

6019 

6020 

6022 


6024 

6026 

6027 


SIZE  OF  TABLE 

NK=12 

TAB(1)=0.02 

TA8(2)=0o04 

TA8(3)=0.06 

TAB(4)=0.08 

TAB(5)=0.10 

TA8(6)=0.15 

TAB(7)-0»20 

TAB(8)=0.25 

TAB(9)=0.30 

TAB(10)=0.4 

TAB(il)=0.5 

TAB(12)=1.0 

DO  6012  1=1 i 18 

PR(I)=0.0 

NKl=NK+2 

00  6014  I=1»NK1 

TEMPORARY  USE  PARTICLE  STORAGE  FOR  EDITING 
AM(I)=0. 

XL(I)=0. 

YL(I)=0. 

AMK(I)=0.0 

PK(I)=0.Q 

QK( I )=0«0 

DO  6028  K=2*KMAX 

WSB=(U(K)**2+V(K)  :<*2)/2.0 

IF (AMD (K) } 9917# 60 19 » 6017 

PR(1) =AMD(K)*AID(X)+PR(1) 

PR ( 2 ) = AMD ( K ) +WSB+PR ( 2 ) 

PR(4)=AMD(K)+PR(4) 

IF(AMX(K)+AMD(K) )9917»6028»6020 
I=NK1 

IF(V(K) ) 6026 » 6026 » 6022 
WSA=ABS(U(K))/V(K) 

DO  6024  I=i»NK 

IF (TA8( I J-WSA) 6024* 6026*6026 

CONTINUE  • 

I=NK+1 

WSsAMX'K) 

AMK v I ) =AMK  U ) +AMX ( K ) +AMD ( K ) 

XL ( I ) "XL ( I ) +U ( K ) *AMD ( K ) 

YL ( I ) =YL ( I ) +V ( K ) *AMD ( K ) 
PX(I)=PKtI)+U(K)*AMX(K) 
QK(I)=QK(I)+V(K)*AMX(K) 

PR ( 5 ) =PR ( 5 ) + A I X ( K ) * AMX ( K ) 

PR ( o ) =PR ( 6 ) +WSB* AMX ( K ) 


ED IT I860 
EDIT1870 
EDIT1880 
EDIT1890 
EDIT1900 
EDIT1910 
EDIT1920 
EDIT1930 
EDITI940 
EDIT1950 
EDIT1960 
EDIT1970 
EDIT1980 
EDIT1990 
EDIT2000 
EDIT2C10 
ED.IT2020 
EDIT2030 


EDIT2040 

EDIT2050 

ED1T2060 

EDIT2070 

EDIT208C 

EDIT2090 


EDIT2120 

EDIT2130 

EDIT2140 

EDIT2150 

EDIT2160 

EDIT2170 

EDIT2180 

EDIT2190 

EDIT2200 

EDIT2210 

EDIT2220 


EDIT2230 

EDIT2240 

EDIT225Q 

EDIT2260 


/ 
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PR(8)=PR(8HAMX(K> 

6028  CONTINUE 
PR(3)=PR(1)+PR(2) 

PR(7)=PR(5)+PR(6> 

XNR6sPR(7) 

PR { 9 ) =PR ( 1 ) +PR ( 5 ) 
PR(10)=PR(2)+PR(6) 
PR(11)=PR(3)+PR(7) 
PR112)=PR(4)+PR(8) 

IF  ( dTH)  7002 » 7002 f  700-3 

7002  kSA-Q» 

60  TO  7000 

7003  CONTINUE 
wSA=(ETH-PR(ll))/ETH 
IF  ( .'JPOTOOO  »7000  >7001 

7000  NPC=i 

7001  PR  U6 )  =  ( WS  A-ONN )  /FLOAT  ( NPC ) 
ECK=PRU8) 

CNN=WSA 

NPC=0 

C  ***  FOR  PELLET  PROBLEMS  ONLY  **** 

SUM0=0. 

.  SUMX=0 . 

00  800  1=1 , A3 

sumx=sumx+qh;(d 

SUMU=SUMO+YL(I) 

•  aoo  continue 

C  RAD£T=P0SITIVE  AXIAL  MOMENTUM  OF  X 

C  VAB0VE=P0SITIVE  AXIAL  MOMENTUM  OF. 

RADET=SUMX 
VABOVE=SUMD 
U01  SUM=U.O 
SUMU=0 . 

DO  o20  K=2»KMAX 

IF ( AMX (K) ) 810 1 810 1 802 

802  1F(U(K))810»810»C,03 

803  SUM=8UM+AMX(K)*U(K) 

810  IF  ( AMO  ( K ) )  820 1 820 1 821 
821  IF(U(K) ) 820 » 820 » 823 
823  SUMO=SUMO+AMD(K>*U(K) 

620  CONTINUE 

RADER=SUM 

VBLOrSUMO 

pR(iy)=o.o 
DO  0029  I=1»NK 

6029  PR{ I+i9) =PR ( 1+18) +AMK( I ) 
PR(N*+2Q)=0.U 
PR(NX+21)-0«0 
JJ=2(147) 

SUMX=0. 

SUMO=0. 

00  8il  1=1 t IMAX 
K=I  +  1 

UO  613  U=1»UU 
IF(m’./.(K)  )816»816»814 
rii4  IF (.  )816>816»817 

817  SU  .  ->UMX+U(K)*AMX(K) 


EDIT2270 

EDIT2280 

EDIT2290 

EDIT2300 

EDIT2310 

EDIT2320 

EDIT2330 

EDIT2340 

EOIT2350 


EDIT2360 


E0IT2 380 
EDIT2390 
EDXT2400 
EDIT2410 


EDIT2430 


EOIT2450 


EDIT247C 


EDIT2490 

EOIT2500 

EDIT251G 


EOIT2530 

EOIT2540 

EDIT2550 

EDIT2560 

EDIT2570 

EDIT2580 


i 
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816 

IP ( AMO (K) ) 813*813*818 

818 

IF(U(K) )813*S13*019 

•  819 

SU.:i)“SUMD+U(K)*AF)(K) 

813 

K=it+IMAX 

811 

continue 

« 

PBLO=SUMX 

PA80VE=SUM0 

WRITE  (6*8116) PRC*. , NC  *  T  * DTNA * TRAD * DTRAD * NR * Nl *  N2  *  N3  *  N4 

EDIT2590 

WRITE  (6*8117)(PR(I), 1=1*8) 

EDIT2600 

WRITE  (6*8118) (PR(I) *1=9*12) 

EDIT2610 

WRITE  ( 6 » 81 19 )  RADUB *  RAOER , RADET » UVMAX * ETH * ECK 

WRITE (6*8203) RADET , VABOVE *  RADER  »  VBLO * PBLO * PABOVE 

EDIT2620 

WRITE  (6* 9040 )Nl0iJ Mil 

EDIT2630 

WRITE  (6*8124)  (Ir.'.MK(l)  *PR(I+19) » PK ( I)  * QK ( I )  *  1  =  1  ,NK1> 

EDIT2640 

6090 

GO  TO  130 

EDIT2650 

c*#** 

END  OF  S  P  SUB.  OUTINE  **************»************************#«EDIT2660 

c 

EDIT2670 

c 

EDIT2680 

SUbRoUTINE  PLOT  +  i+****>)t*********.#*****$*****¥***>!‘**#****<t******>itEDIT2690 

1000 

GO  TO  1030 

EDIT2700 

1030 

WRITE  (6*8116) PRO  '  *  NC  *  T » DTNA  r  TRAD  » DTRAD  *  NR  *  N1 » N2  >  N3  *  N4 

ED1T2710 

JMAXsJMAX 

WRITE  (6*8307)DX( ’ ) , DY ( 1 ) * XMAX * Y1 » Y2 * Y ( UMAX ) 

EDIT2720 

- 

M=1 

EDIT2740 

IF(JMAX~52) 1034*1036, 1036 

EDXT2750 

1034 

M-IABS ( 51“ JMAX) /2 

EDIT2760 

■1036 

DO  1040  I=1»M 

EDIT2770 

WRITE  (6,8308) 

EDIT2780 

1040 

CONTINUE 

EDIT2790 

1044 

J=I2 

1100 

K=(J-1)*IMAX+1 

EDIT2810 

1105 

00  1180  1=1*11 

K=K+1 

EDIT2830 

1126 

PR(I)=PLOT(l) 

C 

TEST  FOR  DOT  PAr.TICLE 

EDIT2860 

1148 

IF ( A.v.D (K)  )  9917 , 11  :0,1152 

EDIT2870 

C 

TEST  FOR  X  PARTICLE 

EDIT2880 

1150 

IF ( AMX (K») 9917*11 66 *1160 

EDIT2090 

C 

TEST  FOR  MIXED  CELL 

EDIT2900 

1152 

lF(AMX(f.)  )9917, 1162*1164 

EDIT2910 

C 

X  PARTICLE  only 

EDIT2920 

1160 

FR(I)=PLCT<2) 

GO  TO  1180 

EDIT2950 

C 

DOT  PARTICLE  ONLY 

EDIT2960 

1 162 

PRll)=PL0T(3) 

GO  TO  1180 

EDIT2990 

C 

MIXED  CELL 

EDIT3000 

1164 

PR(I)=PL0T(4) 

GO  TO  1180 

EL  5030 

H66 

PR ( I ) “PLOT ( 1 ) 

,30 

continue 

EDIT3060 

•  1200 

IF (MOD (J* 5) ) 1210*1204*1210 

EDIT3070 

1204 

IF(DY( J)-DY(J-l) ) 1206* 1208* 1206 

EDIT3080 

.1206 

/.RlTc(o*6211)DY(U) » J.  (PRC  I)  *  1  =  1*11) 

• 

uO  TO  1224 

EDIT3i00 

1208 

,,RlTc.-6*o201)  J*  (PR(I)  *  1  =  1  *  Ii: 

1-0  Tj  1224 


E01T3120 


oooooooooooo  oooo 


UT 


.12.10  lF(DY(J)”DY(J~l)>l2i2»l2l4rl2l2  EDIT3130 

1212  ViRITE  (6  /  8222)  OY  ( J)  >  ( PR  Cl)  1 1=1#  ID 

GO  TO  1224  EDIT3150 

1214  .-.;UTc(6;3202)  (PR ( * ) > I=l» II) 

1224  J=J-1  EDIT3170 

*.  1226  IF ( J)  1230 » 1230 >1100  EDIT3180 

1230  PR(1)=PL0T(5) 

WRITE (6, 8201)  J;  <PR<  1)  *  1=1 » ID 

WRITE  (6»8302) ( I » 1=0 > IMAX> 5)  EDIT3220 

1240  GO  TO  132  EDIT3290 


OF  PLOT  SUBROUTINE  ****$*>le****************>it*****:*******#*:St**£DIT3300 

EDIT3310 

EDIT3320 

***  '•  SUBROUTINE  L  P  **''  '************************************************£0173530 


5000  WRITE  ( 6 >  8116) PRCR » NC » T » OTNA » TRAD » DTRAD » NR  >  N1 #  N2  r  N3 » N4  E0IT3340 

5004  DO  5030  1=1 » II 

CALL  SLITE  (4)  EDIT3360 

J=I2+1 

K=I2*IMAX+I+1 
DO  5046  L=1»I2 

J=J-1  EDIT3400 

K=K-IMAX  EDIT3410 

5012  IF (AMX (K) +AMD (K) )  '917»5046»5014  EDIT3420 

5014  CALL  SLITET(4»K00'FX)  EDIT3430 

GO  TO ( 5016 » 5019) >  000FX 

5016  WRITE  (6»8135)I»X{I)#0X(I)  EDIT3450 


5019  IF ( AMX (K) ) 5030  r  50  0 » 5031 

5030  WSB=AMD(K)/(TAU(r^DY(J) ) 
ttSb=WSB/Z(U6) 

W  S  A  0  . 

GO  TO  5034 

5031  IF(AMD(K) ) 5032 >50  2»5033 

5032  WSA=AMX(K)/(TAU(i  .  :=DY(J) ) 
wSA=V/SA/Z(  115) 

w'SB^O  » 

GO  TO  5034 

5033  wSA=(AMX(K)+AMD(K' ) / ( TAU ( I ) *DY ( J) ) 

WSB=-.lllli 

5034  wSC=P(K)*l.E+4 
FIRST  COLUMN  J 

SECOND  COLUMN  RADIAL  VELOCITY  CM./SH. 

THIRD  COLUMN  AXIAL  VELOCITY  CM./SH. 

FOURTH  COLUMN  PRESSURE  IN  MEGABARS 
FIFTH  COLUMN  DKE (STATUS  OF  MIXED  CELL) 

SIXTH  COLUMN  MASS  (OF  X  MATERIAL)  IN  GRAMS. 

SEVENTH  COLUMN  SPECIFIC  INTERNAL  ENERGY  FOR  (X)  IN  JERKS/GR 
EIgh f  COLUMN  MASS  (OF  .  MATERIAL)  IN  GRAMS. 

NINTH  COLUMN  SPECIFIC  INTERNAL  ENERGY  FOR  (.)  IN  JERKS/GR. 
TENTH  COLUMN  DENSITY  IN  G/CC. 

ELEVENTH  COLUMN  ..SB 

TWELFTH  COLUMN  Y  (J)  TOP  COORDINATE  OF  CELL  IN  CM. 

I* tj  1 8  WRITE  (6»8108)  J»U(K)  ,V(K)  .  WSC  . THETA  (K) » AMX(K) » AIX(K)  t 
1AMD(K) > AID(K) fWSA> WSB» Y ( J) 


So 46  CONTINUE 
5050  CONTINUE 
GO  TO  136 

C  luO  OF  L  P 


SUBROUTINE  ************* * * *  *  *  *  *  *  * *  *  * 


EDIT3460 

EDIT3490 

EDIT3500 

* ***.>.*  +  IT3510 


ooo  o  o  i—  r>OwOO 
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9901  NK-ilO 

GO  TO  9999 

9905  NK=136 

GO  TO  9999 


ERROR 


ENERGY  CHECK 


9917  NK=6015 

GO  TO  9999 

9920  NK-9Q4 

GO  TO  9999 

9921  NK=912 

GO  TO  9999 

9922  NK=91fl 

GO  TO  9999 

9923  NK=922 

GO  TO  9999 

9924  NK=926 
9999  NR=6 

CALL  DUMP 
0000  RETURN 


NEGATIVE  MASS 


EDIT3520 

EDIT3530 

EDIT3540 

EDIT3550 

EDIT3560 

EDIT3570 

EDIT3580 

EDIT3590 

EDIT3600 

EDIT3610 

EDIT3620 

EDIT3630 

EDIT3640 

EDIT3650 

EDIT3660 

EDIT3670 

EDIT3680 

EDIT3690 

EDIT3700 

EDIT3710 

EDIT3720 

EDIT3740 

EDIT3750 

EDIT3760 

EDIT3770 


FORMATS 

8108  F0RMAT(l3»lX»lPllEi0.3) 

81160FORMAT(8H1PROBLE:  6X»5HCYCLE9X»4HTIME13X»2HDT13X»4hTRAD11X»5HDTRAD1EDIT3790 
IdXf  2HNR6X»  2HNl4X;2HN24X»2HN34X#2HN4/ (F7 , 1 » Ill >  2X  > 1P4E16o7» 110 » 2X  r  4EDIT3800 
216))  EDIT3810 

81l70FOKMAT(lH0//17x2,IAIlGX»2HAKl4Xf5HAI+AK15X»2HAM/4H  D0T3X» 1P4E18o7/3EDIT3820 
1H  X4X»4E18»7)  EDIT3830 

81180FORMAT  ( 12X » 13H — ’•*** - 5Xf  13H - 5X»13H - - —5EDIT3840 

1X.13H - - - "77H  T0TALS1P4E18.7)  EDIT3850 

8119QFOkMAT(2HO  //16X/ 5HRADEB13X 1 5HRADER13X» 5HRA0ET 12X r 7HMAX  VEL13X* 3HTEDIT386Q 
1HE12X»9HREL  ERR0R/7X, 1P6E18.7////)  EDIT3870 

8120  FORMAT (1H0//21H  TAPE  7  DUMP  ON  CYCLEI5////)  EDIT3880 

81240FORMAT (3H  Kl2X» SHAM(K) UX » 9HSUM  AM(K) 11X>4HP(K) 13X>4HQ(K)/(I3f 4X»EDIT3890 
ilP4E18.7) )  EDIT3900 

8131  FORMAT (1H  ///11H  DY(J)  J=1 » 12// ( 10F12 . 3) )  EDIT3910 

8133  FORMAT  (1H  ///11H  Y(J)  J=0»  I2//U0F12.3) )  EDIT3920 

81350FOKMAT ( 1H  ///4H  I  =I3» 6X » 6HX ( I )  =F12. 3» 6X?7HDX ( I )  =F12.3//3H  J8XcEDIT3930 
1 1HU9X » 1HV9X » 3HF/A7X » 3H0 IE7X » 3HAMX7X 1 3HA I X7X » 3HAMD7X 1 3HAID7X >  4HETAX 
2X6X#4HETAD6XflHZ/) 

8201  FORMAT(I10*2H  I54A2)  EOIT3950 

8202  FORMAT (10X»2H  I54A2)  EDIT3960 

8203  FORMAT (3X»1P6E18. 7) 

8211  FORMAT (F7 . 1 » 13 » 2H  I54A2)  EDIT3970 

8222  FORMAT ( F7 • 1 » 3X j 2H  I54A2)  EDIT3980 

8302  FORMAT (I12»10I10)  EDIT3990 

83070FOKMAT (SH  Xl  =1PE12 . o » 3X » 4HX2  =E12.6»3XrGHXMAX  =E12»6>6X*4HYl  =E12EDXT4000 
1.6»3X»4HY2  =E12i6f 3Xf6HYMAX  =E12.6)  EDIT4010 

8508  FORMAT (1H  /)  EDIT402Q 

9040  FORMAT ( 1H  /  616)  EDIT4030 

END  EDIT4040 
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SUBROUTINE  REZONE 
C 

*C  NOTE»  THIS  VERSION  ASSUMES  THAT  WE  ARE 
0  ADDING  (.)  MATERIAL 

C 
'.C 

C  **********  A  2  MATERIAL  OIL  CODE  *************************** 
C  A  2  MATERIAL  REZONE  SUBROUTINE 

C  CONSERVE  MOMENTUM  AND  TOTAL  ENERGY t  INCREASE 

C  ALL  LINEAR  DIMENSIONS  BY  2.  (THUS  4  CELLS 

C  IN  THE  OLD  GRID  ARE  COMBINED  INTO  1  FOR 

C  THE  NEW  GRID.) 

NIMAX=lMAX/2 
NJMAX=JMAX/2 
DO  10  J-l t NUMAX 
K=(J-l)*NlMAX+2 
L= ( o-l ) *2* IMAX+2 
DO  11  I=1»NIMAX 

m=l+imax 

12  wSA=AMX(L)+AMX(M)  !-AMX(L+l)+AMX(M+l) 
tfSAD=AMD ( L ) +AMD ( : : ) +AMD ( L+l ) + AMD ( M+l ) 

IFIWSA+WSAD) 100  > 100 » 101 

100  AMX (K) -0 • 

AIXlK)=0. 

AMD(K)=0. 

AID(K)=0. 

U(K)=0. 

V(K)-0. 

GO  TO  9901 

101  CONTINUE 
8900  CONTINUE 

toSB=  ( AMX  ( L )  +AMD  <».))*(  U  ( L )  **2+V  (L )  **2 ) 
wSB=rtSB+  ( AMX  ( M )  -.D  ( M ) )  *  ( U  ( M )  **2+V  ( M)  **2 ) 

wSB=wSB+ ( AMX ( L+l ) +AMD ( L+l ) ) * ( U (L+l ) **2+V ( L+l ) **2 ) 

«SB=V.SB+  ( AMX  (M+l )  +AMD  (M+l ) )  *  (U  (M+l )  **2+V  (M+l )  **2) 

U ( K ) =U ( L ) * ( AMX ( L ) + AMD (L) )+U(M)*( AMX ( M ) + AMD ( M ) ) 

1+U ( L+l ) * ( AMX ( L+l ) +AMD ( L+ i ) ) +U ( M+l ) * ( AMX ( M+l ) +AMD ( M+l ) ) 
U(K)=U(K)/(WSA+WcAO) 

V(K)=V(L)*(AMX(U+AMD(L)  )+V(M)*(AMX(M)+AMD(M)  > 

1+ V  ( L+l )  *  ( AMX  ( L+i )  +AMD  ( L+l ) )  +V  ( M+l )  *  ( AMX  (M+l )  +AMl,  (M+l ) ) 

V ( K ) =V ( K ) / ( WS A+W  SAD ) 

AIX(K)=AIX(L)*AMX(U+AIX(M)*AMX(M)+AIX(L+U* 

1 AMX ( L+ 1 ) + AMX ( M+ 1 ) *A I X ( M+ 1 ) 

AMX(K)=WSA 

AID  ( K)  =  AID  (L)  *  'uMD(L)  +AID  (M)  *AMD(M)  + 
lAIDlL+1)  * AMD (L+l)  +  AID (M+l) *AMD (M+l) 

AMD ( K. ) =WSAQ 
WS=U(K)**2+V(K)**2 
E=AlX(K)  +  AID (K) +  WSB/2.0 
IF(AMD(K)+AMX(K) )  9901 » 9901 »  500 
800  IF  ( AMD ( K ) )  501*501*502 

•  c  x  only 

501  AIX(K)  =  E/AMX (K)  -  . 5*WS 
DKE (K)-~2» 

AID(K)  =  0. 

GO  TO  9901 

b02  IF ( AMX(K) )  503*503*504 


REZ00010 


REZ00990 

REZOIOOO 

REZ01010 

REZO1020 

REZ01030 

REZ01040 

REZ01050 

REZ01060 


REZ01140 

REZO1150 

REZO1160 


REZOll'/O 
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c 

DOT  ONLY 

503 

AXD(K)  =  E/AMD (K)  -  ,5*  WS 

K 

QKE(K)=-1. 

AIX(K)  =0. 

GO  TO  9901 

■c 

MIXED  CELL 

504 

UQ=E- ( AMX ( K ) +AMD ( SO  ) *WS/2 . 

WSE=AlX(K)+AlD(K) 

AIX(K)=AIX(K)/AMX(K)*DQ/WSE 

A I D ( K ) = A ID { K ) / AMD ( K ) *DQ/WSE 

DKE(K)=1. 

9g01 

IF (K-2) 14#14»13 

C 

SET  CELL  QUANTITIES  OF  OLD  GRID  TO  ZERO. 

13 

AMX(L)=0.0 

AMD (L) SO. 

REZ01210 

U(L)=0.0 

REZ01220 

V(L)=0.0 

REZ01230 

AIX (L) =0,0 

AID(L)=0. 

REZ01240 

P(L)=0.0 

DKE(L)=0. 

REZ01250 

AMX(M)=0.0 

AMD(M)=0« 

REZ01260 

U(M)=0.0 

REZ01270 

V (M) =0  •  0 

REZ01280 

AIX(M)=0.0 

REZO1290 

• 

AID(M)=0. 

P (M) =0 . 0 

DKE(M)=0. 

REZ01300 

AMX (L+l) =0 • 0 

AMD(L+1)S0. 

REZ01310 

U(L+1)=0.0 

REZ01320 

V  (L+D  =0.0 

REZ01330 

AIX(L+1)=0.0 

AID(L+1)=0. 

REZ01340 

P(L+1)=0.C 

DKE(L+1)=0. 

REZ01350 

AMX (M+l) =0.0 

AMD (M+l ) =0 . 

REZ01360 

U( M+l) =0.0 

REZ01370 

V (M+1)=0.0 

REZ01380 

AIX (M+l ) =0 . 0 

AID (M+l ) =0 . 

REZ01390 

P (M+l) =0.0 

DKE(M+1)=0. 

REZ01400 

14 

K-K+l 

REZ01410 

L=L+2 

REZ01420 

11 

continue  • 

REZ01430 

10 

CONTINUE 

REZ01440 

C  CALCULATE  NEW  DY  AND  Y  (JMAX  OF  THEM). 
1=0 

*  DO  200  J=1 »UMAX»2 

1  =  1+1 

DY ( I ) =DY ( J) +DY (U+l ) 

■'  ?00  CONTINUE 

1I=NJMAX+1 
uO  2Ul  J=I I » JMAX 


DY(J)=DY(I> 

201  CONTINUE 
WS=0 , 

DO  202  J=1#JMAX 

Y(J)=DY(U)+WS 

WS=Y(J) 

202  CONTINUE 

CALCULATE  THE  NEW  DX»S  AND  TAU#S 
1=0 

DO  203  J=1»IMAX»2 
1=1+1 

OX(X)=DX(J)+DX(J+l) 

203  CONTINUE 
II=NIMAX+1 

00  204  J=II#IMAX 
OX( J)-DX(I) 

204  CONTINUE 
WS=0. 

V/SA=0. 

DO  205  1=1 # IMAX 

X(I)=OX(I)+WS 

WS=X(I) 

WSB=X(I)**2 
TAU(I)=PIDY*(WSB'  WSA) 

WSA=WSB 

205  CONTINUE 
IMAX=NIMAX 
JMAX=NJMAX 

PREPARE  NOW  TO  S'UFFLE  THE  K  ARRAYS  SUCH 
AS  TO  PRESERVE  K=( J-1)*IMAX+I+1. 

DO  20  N=l> JMAX 
J=JMAX+1~N 
K=(U~1)*IMAX+1+IMAX 
L=(U~1)*( IMAX+IMAX) +1+IMAX 
DO  21  1=1 r IMAX 
IqOQ  AMX(L)=AMX(K) 

DKE(L)=DKE(K> 

AMD(L)=AMD(K) 

AIX(L)=AIX<K> 

AID(L)=AID(I0 

UlL)=U(K) 

V(L)=V(K) 

PtL)=P(K) 

IF (J-i) 1002 » 1002  rlOQl 

1001  AMX(K)=0»0 
AMD  (10=0. 

AIX(K)=0.0 

AID(K)=0.- 

OKE<K)=0. 

V(K)=0t0 

UtX)=0.0 

P(K)=0.0 

1002  K.=K-1 
L=L-1 

21  CONTINUE 
20  CONTINUE 

IMAX=NIMAX*2 


REZ01620 

REZ01630 


REZ01640 
REZ01650 
REZ01660 
REZO 1070 
REZ01680 
REZO 1690 


REZ01700 

REZ01710 

REZO1720 

REZO1730 

REZ01740 

REZO1750 

REZ01760 


REZO1770 

REZO1780 

REZ0179  0 

REZ018W 

REZ018^/ 

REZOlfl^ 

REZOIS30 

REZ01840 


vjMAA=NUMrtX*2 
I  UNIMAX  H 
uJ=WJMAX+l 

C  ADU  ON  NEW  MASS  WITH  0ENSITY=Z ( 111 )  IN  TARGET 
uO  bU  I=1»NIMAX 
in  -  (oj”l )  +IMAX+I+1 
L»0  oU  J=uJ*UMAX 
AMO ( K) =Z ( 111 ) *TAU( I ) *DY (0) 

60  K=K+IMAX 
50  CONTINUE 

UU=<Z(147)/2.+.2) 

oJ=<J  J+l 

UO  ol  UII#IMAX 

K=i+i+(Ju-X)*lKAX 

uO  b2  J=JJ»JMAX 

AMu( K) =2( 111)  *T  AU(  I)  ♦OY  ( J) 

62  K=K+XMAX 

61  CONTINUE 

C  kESc.T  ACTIVt.  GRIJ  MARKERS. 

«j  J-«j  J~1 

-(147)=UJ 

xl=il/2+2 

12=12/2+2 

wS=T+UTNA 

i-,K=Nc+l 

C  EDIT  THE  NEW  GRID. 

WRITE  (d*8004)  rt'i*NK»uX(li 

WRITE  ( 6*  8007)  I  '.AXf  (X< I) *  1=0* IMAX/ 

WRITE  ( b* 80Ub)  Ji -AXi  ( Y ( J)  *U=0*JMAX) 
r.RiTt  (b*80Uy)I.''.AX,  (uXU)  *I=i*IMAX) 

WRITc  (6 *8010) UMAX* (uY(U)  *U=1*UMAX) 

wRITc  {b»80il)lMAX.  ( TAU ( I )  *1=1*IMAX) 

isMrtX=IMAX*UMAX+l 

1MAaA=IMAX+1 

uMAXA-UMAX+1 

KMAXA-KMAX+i 

RETURN 


RE201850 


4, 

'  !• 

/, 

\ 


X 

! 

I 


8i.040FORMrtT(lH  ////c2 H  PR08UEM  REEONED  AT  T=1PE12.6* 6x * 5HCYCLEI4 *0X * 3HoRt/02l90  r 
1a=E12.6////) 


8007  FORMAT ( In  /lOH  X(I)  1=0*I2/(5F16,6))  ,  * 

8008  FORMAT ( 1H  /10H  Y(J)  U=0 *  12/ ( 5F16.6) )  RE  *  ’ 

8009  FORMAT ( 1H  /11H  OXU)  1=1  *  12/ ( 5F16 , 6) ) 

8010  FORMAT ( lri  /11H  UY(J)  J=1 *  12/ ( 5F16 . 6) ) 

8011  FORMAT  ( 1H  /loH  AREA ( I )  1  =  1  *  12/ (F16 . 6* 4F18 .6) )  ' 

ENU  j  v 


/ 

I 


-**ssaav~ 


:VV. 


